Merge pull request #949 from fortran-lang/clean-registry-cache

Clear registry cache using `fpm clean --registry-cache`

Author: henilp105

src/fpm.f90

@@ -27,6 +27,7 @@ module fpm
                                         & stderr => error_unit
 use iso_c_binding, only: c_char, c_ptr, c_int, c_null_char, c_associated, c_f_pointer
 use fpm_environment, only: os_is_unix
+use fpm_settings, only: fpm_global_settings, get_global_settings
 
 implicit none
 private
@@ -698,21 +699,30 @@ subroutine delete_skip(is_unix)
     end do
 end subroutine delete_skip
 
-!> Delete the build directory including or excluding dependencies.
+!> Delete the build directory including or excluding dependencies. Can be used
+!> to clear the registry cache.
 subroutine cmd_clean(settings)
     !> Settings for the clean command.
     class(fpm_clean_settings), intent(in) :: settings
 
     character :: user_response
+    type(fpm_global_settings) :: global_settings
+    type(error_t), allocatable :: error
+
+    ! Clear registry cache
+    if (settings%registry_cache) then
+        call get_global_settings(global_settings, error) 
+        if (allocated(error)) return
+
+        call os_delete_dir(os_is_unix(), global_settings%registry_settings%cache_path)
+    end if
 
     if (is_dir('build')) then
         ! Remove the entire build directory
-        if (settings%clean_call) then
+        if (settings%clean_all) then
             call os_delete_dir(os_is_unix(), 'build'); return
-        end if
-
         ! Remove the build directory but skip dependencies
-        if (settings%clean_skip) then
+        else if (settings%clean_skip) then
             call delete_skip(os_is_unix()); return
         end if
 

src/fpm_command_line.f90

@@ -126,7 +126,8 @@ module fpm_command_line
 
 type, extends(fpm_cmd_settings)   :: fpm_clean_settings
     logical                       :: clean_skip = .false.
-    logical                       :: clean_call = .false.
+    logical                       :: clean_all = .false.
+    logical                       :: registry_cache = .false.
 end type
 
 type, extends(fpm_build_settings) :: fpm_publish_settings
@@ -676,14 +677,27 @@ subroutine get_command_line_settings(cmd_settings)
 
         case('clean')
             call set_args(common_args // &
+            &   ' --registry-cache'   // &
             &   ' --skip'             // &
             &   ' --all',                &
                 help_clean, version_text)
-            allocate(fpm_clean_settings :: cmd_settings)
-            call get_current_directory(working_dir, error)
-            cmd_settings=fpm_clean_settings( &
-            &   clean_skip=lget('skip'),     &
-            &   clean_call=lget('all'))
+
+            block
+                logical :: skip, clean_all
+
+                skip = lget('skip')
+                clean_all = lget('all')
+
+                if (all([skip, clean_all])) then
+                    call fpm_stop(6, 'Do not specify both --skip and --all options on the clean subcommand.')
+                end if
+
+                allocate(fpm_clean_settings :: cmd_settings)
+                cmd_settings = fpm_clean_settings( &
+                &   registry_cache=lget('registry-cache'), &
+                &   clean_skip=skip, &
+                &   clean_all=clean_all)
+            end block
 
         case('publish')
             call set_args(common_args // compiler_args //'&
@@ -823,7 +837,7 @@ subroutine set_help()
    '      [--list] [--compiler COMPILER_NAME] [-- ARGS]                             ', &
    ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH]        ', &
    '         [options]                                                              ', &
-   ' clean [--skip] [--all]                                                         ', &
+   ' clean [--skip] [--all] [--registry-cache]                                      ', &
    ' publish [--token TOKEN] [--show-package-version] [--show-upload-data]          ', &
    '         [--dry-run] [--verbose]                                                ', &
    ' ']
@@ -952,7 +966,7 @@ subroutine set_help()
     '    list [--list]                                                               ', &
     '    install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH]     ', &
     '            [options]                                                           ', &
-    '    clean [--skip] [--all]                                                      ', &
+    '    clean [--skip] [--all] [--registry-cache]                                   ', &
     '    publish [--token TOKEN] [--show-package-version] [--show-upload-data]       ', &
     '            [--dry-run] [--verbose]                                             ', &
     '                                                                                ', &
@@ -964,12 +978,15 @@ subroutine set_help()
     help_text_flag, &
     '  --list     List candidates instead of building or running them. On   ', &
     '             the fpm(1) command this shows a brief list of subcommands.', &
-    '  --runner CMD   Provides a command to prefix program execution paths. ', &
+    '  --runner CMD  Provides a command to prefix program execution paths.  ', &
     '  -- ARGS    Arguments to pass to executables.                         ', &
     '  --skip     Delete directories in the build/ directory without        ', &
-    '             prompting, but skip dependencies.                         ', &
+    '             prompting, but skip dependencies. Cannot be used together ', &
+    '             with --all.                                               ', &
     '  --all      Delete directories in the build/ directory without        ', &
-    '             prompting, including dependencies.                        ', &
+    '             prompting, including dependencies. Cannot be used together', &
+    '             with --skip.                                              ', &
+    '  --registry-cache  Delete registry cache.                             ', &
     '                                                                       ', &
     'VALID FOR ALL SUBCOMMANDS                                              ', &
     '  --help     Show help text and exit                                   ', &
@@ -1433,10 +1450,12 @@ subroutine set_help()
     'DESCRIPTION', &
     ' Prompts the user to confirm deletion of the build. If affirmative,', &
     ' directories in the build/ directory are deleted, except dependencies.', &
+    ' Use the --registry-cache option to delete the registry cache.', &
     '', &
     'OPTIONS', &
-    ' --skip           delete the build without prompting but skip dependencies.', &
-    ' --all            delete the build without prompting including dependencies.', &
+    ' --skip            Delete the build without prompting but skip dependencies.', &
+    ' --all             Delete the build without prompting including dependencies.', &
+    ' --registry-cache  Delete registry cache.', &
     '' ]
     help_publish=[character(len=80) :: &
     'NAME', &

src/fpm_settings.f90

@@ -113,7 +113,7 @@ subroutine get_global_settings(global_settings, error)
   subroutine use_default_registry_settings(global_settings)
     type(fpm_global_settings), intent(inout) :: global_settings
 
-    allocate (global_settings%registry_settings)
+    if (.not. allocated(global_settings%registry_settings)) allocate (global_settings%registry_settings)
     global_settings%registry_settings%url = official_registry_base_url
     global_settings%registry_settings%cache_path = join_path(global_settings%path_to_config_folder_or_empty(), &
     & 'dependencies')

test/cli_test/cli_test.f90

@@ -29,14 +29,15 @@ program main
 logical                              :: w_t,act_w_t          ; namelist/act_cli/act_w_t
 logical                              :: c_s,act_c_s          ; namelist/act_cli/act_c_s
 logical                              :: c_a,act_c_a          ; namelist/act_cli/act_c_a
+logical                              :: reg_c,act_reg_c      ; namelist/act_cli/act_reg_c
 logical                              :: show_v,act_show_v    ; namelist/act_cli/act_show_v
 logical                              :: show_u_d,act_show_u_d; namelist/act_cli/act_show_u_d
 logical                              :: dry_run,act_dry_run  ; namelist/act_cli/act_dry_run
 character(len=:), allocatable        :: token, act_token     ; namelist/act_cli/act_token
 
 character(len=:), allocatable        :: profile,act_profile  ; namelist/act_cli/act_profile
 character(len=:), allocatable        :: args,act_args        ; namelist/act_cli/act_args
-namelist/expected/cmd,cstat,estat,w_e,w_t,c_s,c_a,name,profile,args,show_v,show_u_d,dry_run,token
+namelist/expected/cmd,cstat,estat,w_e,w_t,c_s,c_a,reg_c,name,profile,args,show_v,show_u_d,dry_run,token
 integer                              :: lun
 logical,allocatable                  :: tally(:)
 logical,allocatable                  :: subtally(:)
@@ -75,6 +76,7 @@ program main
 'CMD="clean",                                                      NAME=, ARGS="",', &
 'CMD="clean --skip",                                        C_S=T, NAME=, ARGS="",', &
 'CMD="clean --all",                                         C_A=T, NAME=, ARGS="",', &
+'CMD="clean --registry-cache",                            REG_C=T, NAME=, ARGS="",', &
 'CMD="publish --token abc --show-package-version",       SHOW_V=T, NAME=, token="abc",ARGS="",', &
 'CMD="publish --token abc --show-upload-data",           SHOW_U_D=T, NAME=, token="abc",ARGS="",', &
 'CMD="publish --token abc --dry-run",                    DRY_RUN=T, NAME=, token="abc",ARGS="",', &
@@ -111,6 +113,7 @@ program main
       w_t=.false.                    ! --test
       c_s=.false.                    ! --skip
       c_a=.false.                    ! --all
+      reg_c=.false.                  ! --registry-cache
       show_v=.false.                 ! --show-package-version
       show_u_d=.false.               ! --show-upload-data
       dry_run=.false.                ! --dry-run
@@ -134,6 +137,7 @@ program main
              act_w_t=.false.
              act_c_s=.false.
              act_c_a=.false.
+             act_reg_c=.false.
              act_show_v=.false.
              act_show_u_d=.false.
              act_dry_run=.false.
@@ -148,6 +152,9 @@ program main
              subtally=[logical ::]
              call test_test('NAME',all(act_name==name))
              call test_test('PROFILE',act_profile==profile)
+             call test_test('SKIP',act_c_s.eqv.c_s)
+             call test_test('ALL',act_c_a.eqv.c_a)
+             call test_test('REGISTRY-CACHE',act_reg_c.eqv.reg_c)
              call test_test('WITH_EXPECTED',act_w_e.eqv.w_e)
              call test_test('WITH_TESTED',act_w_t.eqv.w_t)
              call test_test('WITH_TEST',act_w_t.eqv.w_t)
@@ -241,6 +248,7 @@ subroutine parse()
 act_w_t=.false.
 act_c_s=.false.
 act_c_a=.false.
+act_reg_c=.false.
 act_show_v=.false.
 act_show_u_d=.false.
 act_dry_run=.false.
@@ -264,7 +272,8 @@ subroutine parse()
     if (allocated(settings%args)) act_args=settings%args
 type is (fpm_clean_settings)
     act_c_s=settings%clean_skip
-    act_c_a=settings%clean_call
+    act_c_a=settings%clean_all
+    act_reg_c=settings%registry_cache
 type is (fpm_install_settings)
 type is (fpm_publish_settings)
     act_show_v=settings%show_package_version
@@ -275,7 +284,6 @@ subroutine parse()
 
 open(file='_test_cli',newunit=lun,delim='quote')
 write(lun,nml=act_cli,delim='quote')
-!!write(*,nml=act_cli)
 close(unit=lun)
 
 end subroutine parse