From 7f76973b5935c644dcf6be68068ccffb857af391 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Jun 2023 20:26:19 +0700 Subject: [PATCH 01/13] Reformat and remote unnecessary statements --- src/fpm_settings.f90 | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/fpm_settings.f90 b/src/fpm_settings.f90 index 0e01ac5768..1b1e41aeca 100644 --- a/src/fpm_settings.f90 +++ b/src/fpm_settings.f90 @@ -106,7 +106,7 @@ subroutine get_global_settings(global_settings, error) call use_default_registry_settings(global_settings) end if - end subroutine get_global_settings + end !> Default registry settings are typically applied if the config file doesn't exist or no registry table was found in !> the global config file. @@ -117,7 +117,7 @@ subroutine use_default_registry_settings(global_settings) global_settings%registry_settings%url = official_registry_base_url global_settings%registry_settings%cache_path = join_path(config_path(global_settings), & & 'dependencies') - end subroutine use_default_registry_settings + end !> Read registry settings from the global config file. subroutine get_registry_settings(table, global_settings, error) @@ -208,19 +208,19 @@ subroutine get_registry_settings(table, global_settings, error) if (allocated(error)) return end if else if (.not. allocated(path)) then - global_settings%registry_settings%cache_path = join_path(config_path(global_settings), & - & 'dependencies') + global_settings%registry_settings%cache_path = join_path(config_path(global_settings), & + & 'dependencies') end if - end subroutine get_registry_settings + end !> True if the global config file is not at the default location. pure logical function has_custom_location(self) class(fpm_global_settings), intent(in) :: self has_custom_location = allocated(self%path_to_config_folder) .and. allocated(self%config_file_name) - if (.not.has_custom_location) return - has_custom_location = len_trim(self%path_to_config_folder)>0 .and. len_trim(self%config_file_name)>0 - end function + if (.not. has_custom_location) return + has_custom_location = len_trim(self%path_to_config_folder) > 0 .and. len_trim(self%config_file_name) > 0 + end !> The full path to the global config file. function full_path(self) result(result) @@ -228,7 +228,7 @@ function full_path(self) result(result) character(len=:), allocatable :: result result = join_path(config_path(self), self%config_file_name) - end function + end !> The path to the global config directory. function config_path(self) @@ -236,10 +236,10 @@ function config_path(self) character(len=:), allocatable :: config_path if (allocated(self%path_to_config_folder)) then - config_path = self%path_to_config_folder + config_path = self%path_to_config_folder else - config_path = "" + config_path = "" end if - end function config_path + end -end module fpm_settings +end From f3150e3176439493df6c465f214981a95ff9fa9f Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 18 Jun 2023 15:18:56 +0700 Subject: [PATCH 02/13] Enter path to global config file via the command line --- src/fpm.f90 | 30 ++++++------- src/fpm/cmd/update.f90 | 10 ++--- src/fpm/dependency.f90 | 82 +++++++++++++++++++++-------------- src/fpm_command_line.f90 | 92 +++++++++++++++++++++++++++------------- src/fpm_filesystem.F90 | 4 +- src/fpm_settings.f90 | 3 +- 6 files changed, 137 insertions(+), 84 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index e8ad5f255f..20fadaad58 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -42,7 +42,6 @@ subroutine build_model(model, settings, package, error) integer :: i, j type(package_config_t) :: dependency character(len=:), allocatable :: manifest, lib_dir - character(len=:), allocatable :: version logical :: has_cpp logical :: duplicates_found type(string_t) :: include_dir @@ -75,7 +74,8 @@ subroutine build_model(model, settings, package, error) if (allocated(error)) return ! Create dependencies - call new_dependency_tree(model%deps, cache=join_path("build", "cache.toml")) + call new_dependency_tree(model%deps, cache=join_path("build", "cache.toml"), & + & path_to_config=settings%path_to_config) ! Build and resolve model dependencies call model%deps%add(package, error) @@ -324,7 +324,7 @@ end subroutine check_modules_for_duplicates subroutine check_module_names(model, error) type(fpm_model_t), intent(in) :: model type(error_t), allocatable, intent(out) :: error - integer :: i,j,k,l,m + integer :: k,l,m logical :: valid,errors_found,enforce_this_file type(string_t) :: package_name,module_name,package_prefix @@ -621,13 +621,13 @@ subroutine cmd_run(settings,test) contains subroutine compact_list_all() integer, parameter :: LINE_WIDTH = 80 - integer :: i, j, nCol - j = 1 + integer :: ii, jj, nCol + jj = 1 nCol = LINE_WIDTH/col_width write(stderr,*) 'Available names:' - do i=1,size(targets) + do ii=1,size(targets) - exe_target => targets(i)%ptr + exe_target => targets(ii)%ptr if (exe_target%target_type == FPM_TARGET_EXECUTABLE .and. & allocated(exe_target%dependencies)) then @@ -636,9 +636,9 @@ subroutine compact_list_all() if (exe_source%unit_scope == run_scope) then - write(stderr,'(A)',advance=(merge("yes","no ",modulo(j,nCol)==0))) & + write(stderr,'(A)',advance=(merge("yes","no ",modulo(jj,nCol)==0))) & & [character(len=col_width) :: basename(exe_target%output_file, suffix=.false.)] - j = j + 1 + jj = jj + 1 end if end if @@ -648,14 +648,14 @@ end subroutine compact_list_all subroutine compact_list() integer, parameter :: LINE_WIDTH = 80 - integer :: i, j, nCol - j = 1 + integer :: ii, jj, nCol + jj = 1 nCol = LINE_WIDTH/col_width write(stderr,*) 'Matched names:' - do i=1,size(executables) - write(stderr,'(A)',advance=(merge("yes","no ",modulo(j,nCol)==0))) & - & [character(len=col_width) :: basename(executables(i)%s, suffix=.false.)] - j = j + 1 + do ii=1,size(executables) + write(stderr,'(A)',advance=(merge("yes","no ",modulo(jj,nCol)==0))) & + & [character(len=col_width) :: basename(executables(ii)%s, suffix=.false.)] + jj = jj + 1 enddo write(stderr,*) end subroutine compact_list diff --git a/src/fpm/cmd/update.f90 b/src/fpm/cmd/update.f90 index e1bcb7326c..09f1450c1b 100644 --- a/src/fpm/cmd/update.f90 +++ b/src/fpm/cmd/update.f90 @@ -24,18 +24,16 @@ subroutine cmd_update(settings) call get_package_data(package, "fpm.toml", error, apply_defaults=.true.) call handle_error(error) - if (.not.exists("build")) then + if (.not. exists("build")) then call mkdir("build") call filewrite(join_path("build", ".gitignore"),["*"]) end if cache = join_path("build", "cache.toml") - if (settings%clean) then - call delete_file(cache) - end if + if (settings%clean) call delete_file(cache) - call new_dependency_tree(deps, cache=cache, & - verbosity=merge(2, 1, settings%verbose)) + call new_dependency_tree(deps, cache=cache, verbosity=merge(2, 1, settings%verbose), & + & path_to_config=settings%path_to_config) call deps%add(package, error) call handle_error(error) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 600c43fdb2..53e113a585 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -59,7 +59,7 @@ module fpm_dependency use fpm_environment, only: get_os_type, OS_WINDOWS, os_is_unix use fpm_error, only: error_t, fatal_error use fpm_filesystem, only: exists, join_path, mkdir, canon_path, windows_path, list_files, is_dir, basename, & - os_delete_dir, get_temp_filename + os_delete_dir, get_temp_filename, parent_dir use fpm_git, only: git_target_revision, git_target_default, git_revision, operator(==) use fpm_manifest, only: package_config_t, dependency_config_t, get_package_data use fpm_manifest_dependency, only: manifest_has_changed @@ -123,7 +123,11 @@ module fpm_dependency type(dependency_node_t), allocatable :: dep(:) !> Cache file character(len=:), allocatable :: cache + !> Custom path to the global config file + character(len=:), allocatable :: path_to_config + contains + !> Overload procedure to add new dependencies to the tree generic :: add => add_project, add_project_dependencies, add_dependencies, & add_dependency, add_dependency_node @@ -183,24 +187,24 @@ module fpm_dependency contains !> Create a new dependency tree - subroutine new_dependency_tree(self, verbosity, cache) + subroutine new_dependency_tree(self, verbosity, cache, path_to_config) !> Instance of the dependency tree type(dependency_tree_t), intent(out) :: self !> Verbosity of printout integer, intent(in), optional :: verbosity !> Name of the cache file character(len=*), intent(in), optional :: cache + !> Path to the global config file. + character(len=*), intent(in), optional :: path_to_config call resize(self%dep) self%dep_dir = join_path("build", "dependencies") - if (present(verbosity)) then - self%verbosity = verbosity - end if + if (present(verbosity)) self%verbosity = verbosity - if (present(cache)) then - self%cache = cache - end if + if (present(cache)) self%cache = cache + + if (present(path_to_config)) self%path_to_config = path_to_config end subroutine new_dependency_tree @@ -311,15 +315,15 @@ subroutine add_project(self, package, error) ! After resolving all dependencies, check if we have cached ones to avoid updates if (allocated(self%cache)) then - call new_dependency_tree(cached, verbosity=self%verbosity,cache=self%cache) + call new_dependency_tree(cached, verbosity=self%verbosity, cache=self%cache) call cached%load(self%cache, error) if (allocated(error)) return ! Skip root node - do id=2,cached%ndep - cached%dep(id)%cached = .true. - call self%add(cached%dep(id), error) - if (allocated(error)) return + do id = 2, cached%ndep + cached%dep(id)%cached = .true. + call self%add(cached%dep(id), error) + if (allocated(error)) return end do end if @@ -443,13 +447,13 @@ subroutine add_dependency_node(self, dependency, error) ! the manifest has priority if (dependency%cached) then if (dependency_has_changed(dependency, self%dep(id), self%verbosity, self%unit)) then - if (self%verbosity>0) write (self%unit, out_fmt) "Dependency change detected:", dependency%name - self%dep(id)%update = .true. + if (self%verbosity > 0) write (self%unit, out_fmt) "Dependency change detected:", dependency%name + self%dep(id)%update = .true. else - ! Store the cached one - self%dep(id) = dependency - self%dep(id)%update = .false. - endif + ! Store the cached one + self%dep(id) = dependency + self%dep(id)%update = .false. + end if end if else ! New dependency: add from scratch @@ -498,7 +502,7 @@ subroutine update_dependency(self, name, error) associate (dep => self%dep(id)) if (allocated(dep%git) .and. dep%update) then - if (self%verbosity>0) write (self%unit, out_fmt) "Update:", dep%name + if (self%verbosity > 0) write (self%unit, out_fmt) "Update:", dep%name proj_dir = join_path(self%dep_dir, dep%name) call dep%git%checkout(proj_dir, error) if (allocated(error)) return @@ -545,8 +549,24 @@ subroutine resolve_dependencies(self, root, error) type(error_t), allocatable, intent(out) :: error type(fpm_global_settings) :: global_settings + character(:), allocatable :: parent_directory integer :: ii + ! Register path to global config file if it was entered via the command line. + if (allocated(self%path_to_config)) then + if (len_trim(self%path_to_config) > 0) then + parent_directory = parent_dir(self%path_to_config) + + if (len_trim(parent_directory) == 0) then + global_settings%path_to_config_folder = "." + else + global_settings%path_to_config_folder = parent_directory + end if + + global_settings%config_file_name = basename(self%path_to_config) + end if + end if + call get_global_settings(global_settings, error) if (allocated(error)) return @@ -722,7 +742,7 @@ subroutine check_and_read_pkg_data(json, node, download_url, version, error) character(:), allocatable :: version_key, version_str, error_message, namespace, name namespace = "" - name = "UNNAMED_NODE" + name = "UNNAMED_NODE" if (allocated(node%namespace)) namespace = node%namespace if (allocated(node%name)) name = node%name @@ -1199,27 +1219,27 @@ logical function dependency_has_changed(cached, manifest, verbosity, iunit) resu !> may not have it if (allocated(cached%version) .and. allocated(manifest%version)) then if (cached%version /= manifest%version) then - if (verbosity>1) write(iunit,out_fmt) "VERSION has changed: "//cached%version%s()//" vs. "//manifest%version%s() - return - endif + if (verbosity > 1) write (iunit, out_fmt) "VERSION has changed: "//cached%version%s()//" vs. "//manifest%version%s() + return + end if else - if (verbosity>1) write(iunit,out_fmt) "VERSION has changed presence " + if (verbosity > 1) write (iunit, out_fmt) "VERSION has changed presence " end if if (allocated(cached%revision) .and. allocated(manifest%revision)) then if (cached%revision /= manifest%revision) then - if (verbosity>1) write(iunit,out_fmt) "REVISION has changed: "//cached%revision//" vs. "//manifest%revision + if (verbosity > 1) write (iunit, out_fmt) "REVISION has changed: "//cached%revision//" vs. "//manifest%revision return - endif + end if else - if (verbosity>1) write(iunit,out_fmt) "REVISION has changed presence " + if (verbosity > 1) write (iunit, out_fmt) "REVISION has changed presence " end if if (allocated(cached%proj_dir) .and. allocated(manifest%proj_dir)) then if (cached%proj_dir /= manifest%proj_dir) then - if (verbosity>1) write(iunit,out_fmt) "PROJECT DIR has changed: "//cached%proj_dir//" vs. "//manifest%proj_dir + if (verbosity > 1) write (iunit, out_fmt) "PROJECT DIR has changed: "//cached%proj_dir//" vs. "//manifest%proj_dir return - endif + end if else - if (verbosity>1) write(iunit,out_fmt) "PROJECT DIR has changed presence " + if (verbosity > 1) write (iunit, out_fmt) "PROJECT DIR has changed presence " end if !> All checks passed: the two dependencies have no differences diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index f1ced79308..63c47b9676 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -54,6 +54,7 @@ module fpm_command_line type, abstract :: fpm_cmd_settings character(len=:), allocatable :: working_dir + character(len=:), allocatable :: path_to_config logical :: verbose=.true. end type @@ -221,7 +222,7 @@ subroutine get_command_line_settings(cmd_settings) type(fpm_install_settings), allocatable :: install_settings type(version_t) :: version character(len=:), allocatable :: common_args, compiler_args, run_args, working_dir, & - & c_compiler, cxx_compiler, archiver, version_s, token_s + & c_compiler, cxx_compiler, archiver, version_s, token_s, global_config character(len=*), parameter :: fc_env = "FC", cc_env = "CC", ar_env = "AR", & & fflags_env = "FFLAGS", cflags_env = "CFLAGS", cxxflags_env = "CXXFLAGS", ldflags_env = "LDFLAGS", & @@ -289,7 +290,8 @@ subroutine get_command_line_settings(cmd_settings) case('run') call set_args(common_args // compiler_args // run_args //'& & --all F & - & --example F& + & --example F & + & --global-config " " & & --',help_run,version_text) call check_build_vals() @@ -300,7 +302,6 @@ subroutine get_command_line_settings(cmd_settings) names=[character(len=len(names)) :: ] endif - if(specified('target') )then call split(sget('target'),tnames,delimiters=' ,:') names=[character(len=max(len(names),len(tnames))) :: names,tnames] @@ -320,6 +321,7 @@ subroutine get_command_line_settings(cmd_settings) c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') + global_config = sget('global-config') allocate(fpm_run_settings :: cmd_settings) val_runner=sget('runner') if(specified('runner') .and. val_runner=='')val_runner='echo' @@ -331,6 +333,7 @@ subroutine get_command_line_settings(cmd_settings) & c_compiler=c_compiler, & & cxx_compiler=cxx_compiler, & & archiver=archiver, & + & path_to_config=global_config, & & flag=val_flag, & & cflag=val_cflag, & & cxxflag=val_cxxflag, & @@ -347,6 +350,7 @@ subroutine get_command_line_settings(cmd_settings) & --list F & & --show-model F & & --tests F & + & --global-config " " & & --',help_build,version_text) call check_build_vals() @@ -354,6 +358,8 @@ subroutine get_command_line_settings(cmd_settings) c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') + global_config = sget('global-config') + allocate( fpm_build_settings :: cmd_settings ) cmd_settings=fpm_build_settings( & & profile=val_profile,& @@ -362,6 +368,7 @@ subroutine get_command_line_settings(cmd_settings) & c_compiler=c_compiler, & & cxx_compiler=cxx_compiler, & & archiver=archiver, & + & path_to_config=global_config, & & flag=val_flag, & & cflag=val_cflag, & & cxxflag=val_cxxflag, & @@ -380,8 +387,8 @@ subroutine get_command_line_settings(cmd_settings) & --example F & & --backfill F & & --full F & - & --bare F', & - & help_new, version_text) + & --bare F & + &', help_new, version_text) select case(size(unnamed)) case(1) if(lget('backfill'))then @@ -414,7 +421,6 @@ subroutine get_command_line_settings(cmd_settings) call fpm_stop(4,' ') endif - allocate(fpm_new_settings :: cmd_settings) if (any( specified([character(len=10) :: 'src','lib','app','test','example','bare'])) & & .and.lget('full') )then @@ -450,7 +456,7 @@ subroutine get_command_line_settings(cmd_settings) & verbose=lget('verbose') ) endif - case('help','manual') + case('help', 'manual') call set_args(common_args, help_help,version_text) if(size(unnamed)<2)then if(unnamed(1)=='help')then @@ -501,16 +507,21 @@ subroutine get_command_line_settings(cmd_settings) case('install') call set_args(common_args // compiler_args // '& - & --no-rebuild F --prefix " " & + & --no-rebuild F & + & --prefix " " & & --list F & - & --libdir "lib" --bindir "bin" --includedir "include"', & - help_install, version_text) + & --libdir "lib" & + & --bindir "bin" & + & --includedir "include" & + & --global-config " " & + &', help_install, version_text) call check_build_vals() c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') + global_config = sget('global-config') allocate(install_settings, source=fpm_install_settings(& list=lget('list'), & profile=val_profile,& @@ -519,6 +530,7 @@ subroutine get_command_line_settings(cmd_settings) c_compiler=c_compiler, & cxx_compiler=cxx_compiler, & archiver=archiver, & + path_to_config=global_config, & flag=val_flag, & cflag=val_cflag, & cxxflag=val_cxxflag, & @@ -533,7 +545,7 @@ subroutine get_command_line_settings(cmd_settings) case('list') call set_args(common_args // '& - & --list F& + & --list F & &', help_list, version_text) if(lget('list'))then help_text = [character(widest) :: help_list_nodash, help_list_dash] @@ -543,8 +555,9 @@ subroutine get_command_line_settings(cmd_settings) call printhelp(help_text) case('test') - call set_args(common_args // compiler_args // run_args // ' --', & - help_test,version_text) + call set_args(common_args // compiler_args // run_args // '& + & --global-config " " & + & -- ', help_test,version_text) call check_build_vals() @@ -568,6 +581,8 @@ subroutine get_command_line_settings(cmd_settings) c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') + global_config = sget('global-config') + allocate(fpm_test_settings :: cmd_settings) val_runner=sget('runner') if(specified('runner') .and. val_runner=='')val_runner='echo' @@ -579,6 +594,7 @@ subroutine get_command_line_settings(cmd_settings) & c_compiler=c_compiler, & & cxx_compiler=cxx_compiler, & & archiver=archiver, & + & path_to_config=global_config, & & flag=val_flag, & & cflag=val_cflag, & & cxxflag=val_cxxflag, & @@ -591,8 +607,11 @@ subroutine get_command_line_settings(cmd_settings) & verbose=lget('verbose') ) case('update') - call set_args(common_args // ' --fetch-only F --clean F', & - help_update, version_text) + call set_args(common_args // '& + & --fetch-only F & + & --clean F & + & --global-config " " & + &', help_update, version_text) if( size(unnamed) > 1 )then names=unnamed(2:) @@ -600,23 +619,33 @@ subroutine get_command_line_settings(cmd_settings) names=[character(len=len(names)) :: ] endif + global_config = sget('global-config') + allocate(fpm_update_settings :: cmd_settings) cmd_settings=fpm_update_settings(name=names, & - fetch_only=lget('fetch-only'), verbose=lget('verbose'), & - clean=lget('clean')) + & fetch_only=lget('fetch-only'), & + & verbose=lget('verbose'), & + & path_to_config=global_config, & + & clean=lget('clean')) case('clean') - call set_args(common_args // & - & ' --skip' // & - & ' --all', & - help_clean, version_text) + call set_args(common_args // '& + & --skip & + & --all & + & --global-config " " & + &', help_clean, version_text) + + global_config = sget('global-config') + allocate(fpm_clean_settings :: cmd_settings) call get_current_directory(working_dir, error) cmd_settings=fpm_clean_settings( & - & is_unix=is_unix, & - & calling_dir=working_dir, & - & clean_skip=lget('skip'), & - clean_call=lget('all')) + & is_unix=is_unix, & + & calling_dir=working_dir, & + & clean_skip=lget('skip'), & + & clean_call=lget('all'), & + & path_to_config=global_config & + &) case('publish') call set_args(common_args // compiler_args //'& @@ -627,6 +656,7 @@ subroutine get_command_line_settings(cmd_settings) & --list F & & --show-model F & & --tests F & + & --global-config " " & & --', help_publish, version_text) call check_build_vals() @@ -634,6 +664,7 @@ subroutine get_command_line_settings(cmd_settings) c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') + global_config = sget('global-config') token_s = sget('token') allocate(fpm_publish_settings :: cmd_settings) @@ -654,6 +685,7 @@ subroutine get_command_line_settings(cmd_settings) & list=lget('list'),& & show_model=lget('show-model'),& & build_tests=lget('tests'),& + & path_to_config=global_config, & & verbose=lget('verbose'),& & token=token_s) @@ -697,7 +729,7 @@ subroutine check_build_vals() val_flag = " " // sget('flag') val_cflag = " " // sget('c-flag') - val_cxxflag = " "// sget('cxx-flag') + val_cxxflag = " " // sget('cxx-flag') val_ldflag = " " // sget('link-flag') val_profile = sget('profile') @@ -780,14 +812,14 @@ subroutine set_help() ' from platform to platform or require independent installation. ', & ' ', & 'OPTION ', & - ' --runner ''CMD'' quoted command used to launch the fpm(1) executables. ', & + ' --runner ''CMD'' quoted command used to launch the fpm(1) executables. ', & ' Available for both the "run" and "test" subcommands. ', & ' If the keyword is specified without a value the default command ', & ' is "echo". ', & ' -- SUFFIX_OPTIONS additional options to suffix the command CMD and executable ', & ' file names with. ', & 'EXAMPLES ', & - ' Use cases for ''fpm run|test --runner "CMD"'' include employing ', & + ' Use cases for ''fpm run|test --runner "CMD"'' include employing ', & ' the following common GNU/Linux and Unix commands: ', & ' ', & ' INTERROGATE ', & @@ -816,7 +848,7 @@ subroutine set_help() ' fpm run --runner "tar cvfz $HOME/bundle.tgz" ', & ' fpm run --runner ldd ', & ' fpm run --runner strip ', & - ' fpm run --runner ''cp -t /usr/local/bin'' ', & + ' fpm run --runner ''cp -t /usr/local/bin'' ', & ' ', & ' # options after executable name can be specified after the -- option ', & ' fpm --runner cp run -- /usr/local/bin/ ', & @@ -1009,7 +1041,7 @@ subroutine set_help() ' any single character and "*" represents any string. ', & ' Note The glob string normally needs quoted to ', & ' the special characters from shell expansion. ', & - ' --all Run all examples or applications. An alias for --target ''*''. ', & + ' --all Run all examples or applications. An alias for --target ''*''.', & ' --example Run example programs instead of applications. ', & help_text_build_common, & help_text_compiler, & diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 9b2112b18a..db0dde98e1 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -76,7 +76,9 @@ subroutine env_variable(var, name) end subroutine env_variable -!> Extract filename from path with/without suffix +!> Extract filename from path with or without suffix. +!> +!> The suffix is included by default. function basename(path,suffix) result (base) character(*), intent(In) :: path diff --git a/src/fpm_settings.f90 b/src/fpm_settings.f90 index 1b1e41aeca..f3d7a74950 100644 --- a/src/fpm_settings.f90 +++ b/src/fpm_settings.f90 @@ -11,6 +11,7 @@ module fpm_settings public :: fpm_global_settings, get_global_settings, get_registry_settings, official_registry_base_url character(*), parameter :: official_registry_base_url = 'https://registry-apis.vercel.app' + character(*), parameter :: default_config_file_name = 'config.toml' type :: fpm_global_settings !> Path to the global config file excluding the file name. @@ -77,7 +78,7 @@ subroutine get_global_settings(global_settings, error) end if ! Use default file name. - global_settings%config_file_name = 'config.toml' + global_settings%config_file_name = default_config_file_name ! Apply default registry settings and return if config file doesn't exist. if (.not. exists(global_settings%full_path())) then From 607c95f971fc690ee384fdecf69db9cc0e0f005a Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 18 Jun 2023 21:44:37 +0700 Subject: [PATCH 03/13] Add to help --- src/fpm_command_line.f90 | 95 ++++++++++++++++++++++------------------ 1 file changed, 53 insertions(+), 42 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 63c47b9676..b477cc9ce3 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -776,21 +776,22 @@ subroutine set_help() help_list_dash = [character(len=80) :: & ' ', & ' build [--compiler COMPILER_NAME] [--profile PROF] [--flag FFLAGS] [--list] ', & - ' [--tests] [--no-prune] ', & + ' [--tests] [--no-prune] [--config-file PATH] ', & ' help [NAME(s)] ', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & ' [--full|--bare][--backfill] ', & - ' update [NAME(s)] [--fetch-only] [--clean] [--verbose] ', & + ' update [NAME(s)] [--fetch-only] [--clean] [--verbose] [--config-file PATH] ', & ' list [--list] ', & ' run [[--target] NAME(s) [--example] [--profile PROF] [--flag FFLAGS] [--all] ', & ' [--runner "CMD"] [--compiler COMPILER_NAME] [--list] [-- ARGS] ', & + ' [--config-file PATH] ', & ' test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--runner "CMD"] ', & - ' [--list] [--compiler COMPILER_NAME] [-- ARGS] ', & + ' [--list] [--compiler COMPILER_NAME] [--config-file PATH] [-- ARGS] ', & ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & - ' [options] ', & - ' clean [--skip] [--all] ', & + ' [--config-file PATH] [options] ', & + ' clean [--skip] [--all] [--config-file PATH] ', & ' publish [--token TOKEN] [--show-package-version] [--show-upload-data] ', & - ' [--dry-run] [--verbose] ', & + ' [--dry-run] [--verbose] [--config-file PATH] ', & ' '] help_usage=[character(len=80) :: & '' ] @@ -900,22 +901,23 @@ subroutine set_help() ' Their syntax is ', & ' ', & ' build [--profile PROF] [--flag FFLAGS] [--list] [--compiler COMPILER_NAME] ', & - ' [--tests] [--no-prune] ', & + ' [--tests] [--no-prune] [--config-file PATH] ', & ' new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & ' [--full|--bare][--backfill] ', & - ' update [NAME(s)] [--fetch-only] [--clean] ', & + ' update [NAME(s)] [--fetch-only] [--clean] [--config-file PATH] ', & ' run [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] [--all] ', & ' [--example] [--runner "CMD"] [--compiler COMPILER_NAME] ', & - ' [--no-prune] [-- ARGS] ', & + ' [--no-prune] [-- ARGS] [--config-file PATH] ', & ' test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] [--list] ', & ' [--runner "CMD"] [--compiler COMPILER_NAME] [--no-prune] [-- ARGS] ', & + ' [--config-file PATH] ', & ' help [NAME(s)] ', & ' list [--list] ', & ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & - ' [options] ', & - ' clean [--skip] [--all] ', & + ' [options] [--config-file PATH] ', & + ' clean [--skip] [--all] [--config-file PATH] ', & ' publish [--token TOKEN] [--show-package-version] [--show-upload-data] ', & - ' [--dry-run] [--verbose] ', & + ' [--dry-run] [--verbose] [--config-file PATH] ', & ' ', & 'SUBCOMMAND OPTIONS ', & ' -C, --directory PATH', & @@ -1017,9 +1019,9 @@ subroutine set_help() ' run(1) - the fpm(1) subcommand to run project applications ', & ' ', & 'SYNOPSIS ', & - ' fpm run [[--target] NAME(s) [--profile PROF] [--flag FFLAGS]', & + ' fpm run [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS]', & ' [--compiler COMPILER_NAME] [--runner "CMD"] [--example]', & - ' [--list] [--all] [-- ARGS]', & + ' [--list] [--all] [--config-file PATH] [-- ARGS]', & ' ', & ' fpm run --help|--version ', & ' ', & @@ -1041,8 +1043,9 @@ subroutine set_help() ' any single character and "*" represents any string. ', & ' Note The glob string normally needs quoted to ', & ' the special characters from shell expansion. ', & - ' --all Run all examples or applications. An alias for --target ''*''.', & + ' --all Run all examples or applications. An alias for --target ''*''. ', & ' --example Run example programs instead of applications. ', & + ' --config-file PATH Custom location of the global config file. ', & help_text_build_common, & help_text_compiler, & help_text_flag, & @@ -1088,7 +1091,7 @@ subroutine set_help() ' ', & 'SYNOPSIS ', & ' fpm build [--profile PROF] [--flag FFLAGS] [--compiler COMPILER_NAME] ', & - ' [--list] [--tests] ', & + ' [--list] [--tests] [--config-file PATH] ', & ' ', & ' fpm build --help|--version ', & ' ', & @@ -1113,12 +1116,13 @@ subroutine set_help() help_text_build_common,& help_text_compiler, & help_text_flag, & - ' --list list candidates instead of building or running them ', & - ' --tests build all tests (otherwise only if needed) ', & - ' --show-model show the model and exit (do not build) ', & - ' --help print this help and exit ', & - ' --version print program version information and exit ', & - ' ', & + ' --list list candidates instead of building or running them', & + ' --tests build all tests (otherwise only if needed) ', & + ' --show-model show the model and exit (do not build) ', & + ' --help print this help and exit ', & + ' --version print program version information and exit ', & + ' --config-file PATH custom location of the global config file ', & + ' ', & help_text_environment, & ' ', & 'EXAMPLES ', & @@ -1268,8 +1272,9 @@ subroutine set_help() ' test(1) - the fpm(1) subcommand to run project tests ', & ' ', & 'SYNOPSIS ', & - ' fpm test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS]', & - ' [--compiler COMPILER_NAME ] [--runner "CMD"] [--list][-- ARGS]', & + ' fpm test [[--target] NAME(s)] [--profile PROF] [--flag FFLAGS] ', & + ' [--compiler COMPILER_NAME ] [--runner "CMD"] [--list] ', & + ' [-- ARGS] [--config-file PATH] ', & ' ', & ' fpm test --help|--version ', & ' ', & @@ -1292,6 +1297,7 @@ subroutine set_help() ' see "fpm help runner" for further details. ', & ' --list list candidate basenames instead of running them. Note they', & ' --list will still be built if not currently up to date. ', & + ' --config-file PATH Custom location of the global config file. ', & ' -- ARGS optional arguments to pass to the test program(s). ', & ' The same arguments are passed to all test names ', & ' specified. ', & @@ -1317,16 +1323,18 @@ subroutine set_help() ' update(1) - manage project dependencies', & '', & 'SYNOPSIS', & - ' fpm update [--fetch-only] [--clean] [--verbose] [NAME(s)]', & + ' fpm update [--fetch-only] [--clean] [--verbose] [NAME(s)] ', & + ' [--global-config PATH] ', & '', & 'DESCRIPTION', & ' Manage and update project dependencies. If no dependency names are', & ' provided all the dependencies are updated automatically.', & '', & 'OPTIONS', & - ' --fetch-only Only fetch dependencies, do not update existing projects', & - ' --clean Do not use previous dependency cache', & - ' --verbose Show additional printout', & + ' --fetch-only Only fetch dependencies, do not update existing projects', & + ' --clean Do not use previous dependency cache', & + ' --config-file PATH Custom location of the global config file', & + ' --verbose Show additional printout', & '', & 'SEE ALSO', & ' The fpm(1) home page at https://github.com/fortran-lang/fpm', & @@ -1338,7 +1346,7 @@ subroutine set_help() 'SYNOPSIS', & ' fpm install [--profile PROF] [--flag FFLAGS] [--list] [--no-rebuild]', & ' [--prefix DIR] [--bindir DIR] [--libdir DIR] [--includedir DIR]', & - ' [--verbose]', & + ' [--verbose] [--global-config PATH]', & '', & 'DESCRIPTION', & ' Subcommand to install fpm projects. Running install will export the', & @@ -1352,16 +1360,17 @@ subroutine set_help() ' but do not install any of them', & help_text_build_common,& help_text_flag, & - ' --no-rebuild do not rebuild project before installation', & - ' --prefix DIR path to installation directory (requires write access),', & - ' the default prefix on Unix systems is $HOME/.local', & - ' and %APPDATA%\local on Windows', & - ' --bindir DIR subdirectory to place executables in (default: bin)', & - ' --libdir DIR subdirectory to place libraries and archives in', & - ' (default: lib)', & - ' --includedir DIR subdirectory to place headers and module files in', & - ' (default: include)', & - ' --verbose print more information', & + ' --no-rebuild do not rebuild project before installation', & + ' --prefix DIR path to installation directory (requires write access),', & + ' the default prefix on Unix systems is $HOME/.local', & + ' and %APPDATA%\local on Windows', & + ' --bindir DIR subdirectory to place executables in (default: bin)', & + ' --libdir DIR subdirectory to place libraries and archives in', & + ' (default: lib)', & + ' --includedir DIR subdirectory to place headers and module files in', & + ' (default: include)', & + ' --config-file PATH custom location of the global config file', & + ' --verbose print more information', & '', & help_text_environment, & '', & @@ -1390,8 +1399,9 @@ subroutine set_help() ' directories in the build/ directory are deleted, except dependencies.', & '', & '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.', & + ' --config-file PATH Custom location of the global config file.', & '' ] help_publish=[character(len=80) :: & 'NAME', & @@ -1399,7 +1409,7 @@ subroutine set_help() '', & 'SYNOPSIS', & ' fpm publish [--token TOKEN] [--show-package-version] [--show-upload-data]', & - ' [--dry-run] [--verbose] ', & + ' [--dry-run] [--verbose] [--global-config PATH]', & '', & ' fpm publish --help|--version', & '', & @@ -1431,6 +1441,7 @@ subroutine set_help() ' --dry-run perform dry run without publishing', & ' --help print this help and exit', & ' --version print program version information and exit', & + ' --config-file PATH custom location of the global config file', & ' --verbose print more information', & '', & 'EXAMPLES', & From 5409778c8e4262f7ce4d710643d569ac3a66f229 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 19 Jun 2023 00:18:36 +0700 Subject: [PATCH 04/13] Rename to config_file --- src/fpm_command_line.f90 | 50 ++++++++++++++++++++-------------------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index b477cc9ce3..bc2b1bf4be 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -222,7 +222,7 @@ subroutine get_command_line_settings(cmd_settings) type(fpm_install_settings), allocatable :: install_settings type(version_t) :: version character(len=:), allocatable :: common_args, compiler_args, run_args, working_dir, & - & c_compiler, cxx_compiler, archiver, version_s, token_s, global_config + & c_compiler, cxx_compiler, archiver, version_s, token_s, config_file character(len=*), parameter :: fc_env = "FC", cc_env = "CC", ar_env = "AR", & & fflags_env = "FFLAGS", cflags_env = "CFLAGS", cxxflags_env = "CXXFLAGS", ldflags_env = "LDFLAGS", & @@ -291,7 +291,7 @@ subroutine get_command_line_settings(cmd_settings) call set_args(common_args // compiler_args // run_args //'& & --all F & & --example F & - & --global-config " " & + & --config-file " " & & --',help_run,version_text) call check_build_vals() @@ -321,7 +321,7 @@ subroutine get_command_line_settings(cmd_settings) c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') - global_config = sget('global-config') + config_file = sget('config-file') allocate(fpm_run_settings :: cmd_settings) val_runner=sget('runner') if(specified('runner') .and. val_runner=='')val_runner='echo' @@ -333,7 +333,7 @@ subroutine get_command_line_settings(cmd_settings) & c_compiler=c_compiler, & & cxx_compiler=cxx_compiler, & & archiver=archiver, & - & path_to_config=global_config, & + & path_to_config=config_file, & & flag=val_flag, & & cflag=val_cflag, & & cxxflag=val_cxxflag, & @@ -350,7 +350,7 @@ subroutine get_command_line_settings(cmd_settings) & --list F & & --show-model F & & --tests F & - & --global-config " " & + & --config-file " " & & --',help_build,version_text) call check_build_vals() @@ -358,7 +358,7 @@ subroutine get_command_line_settings(cmd_settings) c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') - global_config = sget('global-config') + config_file = sget('config-file') allocate( fpm_build_settings :: cmd_settings ) cmd_settings=fpm_build_settings( & @@ -368,7 +368,7 @@ subroutine get_command_line_settings(cmd_settings) & c_compiler=c_compiler, & & cxx_compiler=cxx_compiler, & & archiver=archiver, & - & path_to_config=global_config, & + & path_to_config=config_file, & & flag=val_flag, & & cflag=val_cflag, & & cxxflag=val_cxxflag, & @@ -513,7 +513,7 @@ subroutine get_command_line_settings(cmd_settings) & --libdir "lib" & & --bindir "bin" & & --includedir "include" & - & --global-config " " & + & --config-file " " & &', help_install, version_text) call check_build_vals() @@ -521,7 +521,7 @@ subroutine get_command_line_settings(cmd_settings) c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') - global_config = sget('global-config') + config_file = sget('config-file') allocate(install_settings, source=fpm_install_settings(& list=lget('list'), & profile=val_profile,& @@ -530,7 +530,7 @@ subroutine get_command_line_settings(cmd_settings) c_compiler=c_compiler, & cxx_compiler=cxx_compiler, & archiver=archiver, & - path_to_config=global_config, & + path_to_config=config_file, & flag=val_flag, & cflag=val_cflag, & cxxflag=val_cxxflag, & @@ -556,7 +556,7 @@ subroutine get_command_line_settings(cmd_settings) case('test') call set_args(common_args // compiler_args // run_args // '& - & --global-config " " & + & --config-file " " & & -- ', help_test,version_text) call check_build_vals() @@ -581,7 +581,7 @@ subroutine get_command_line_settings(cmd_settings) c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') - global_config = sget('global-config') + config_file = sget('config-file') allocate(fpm_test_settings :: cmd_settings) val_runner=sget('runner') @@ -594,7 +594,7 @@ subroutine get_command_line_settings(cmd_settings) & c_compiler=c_compiler, & & cxx_compiler=cxx_compiler, & & archiver=archiver, & - & path_to_config=global_config, & + & path_to_config=config_file, & & flag=val_flag, & & cflag=val_cflag, & & cxxflag=val_cxxflag, & @@ -610,7 +610,7 @@ subroutine get_command_line_settings(cmd_settings) call set_args(common_args // '& & --fetch-only F & & --clean F & - & --global-config " " & + & --config-file " " & &', help_update, version_text) if( size(unnamed) > 1 )then @@ -619,23 +619,23 @@ subroutine get_command_line_settings(cmd_settings) names=[character(len=len(names)) :: ] endif - global_config = sget('global-config') + config_file = sget('config-file') allocate(fpm_update_settings :: cmd_settings) cmd_settings=fpm_update_settings(name=names, & & fetch_only=lget('fetch-only'), & & verbose=lget('verbose'), & - & path_to_config=global_config, & + & path_to_config=config_file, & & clean=lget('clean')) case('clean') call set_args(common_args // '& & --skip & & --all & - & --global-config " " & + & --config-file " " & &', help_clean, version_text) - global_config = sget('global-config') + config_file = sget('config-file') allocate(fpm_clean_settings :: cmd_settings) call get_current_directory(working_dir, error) @@ -644,7 +644,7 @@ subroutine get_command_line_settings(cmd_settings) & calling_dir=working_dir, & & clean_skip=lget('skip'), & & clean_call=lget('all'), & - & path_to_config=global_config & + & path_to_config=config_file & &) case('publish') @@ -656,7 +656,7 @@ subroutine get_command_line_settings(cmd_settings) & --list F & & --show-model F & & --tests F & - & --global-config " " & + & --config-file " " & & --', help_publish, version_text) call check_build_vals() @@ -664,7 +664,7 @@ subroutine get_command_line_settings(cmd_settings) c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') - global_config = sget('global-config') + config_file = sget('config-file') token_s = sget('token') allocate(fpm_publish_settings :: cmd_settings) @@ -685,7 +685,7 @@ subroutine get_command_line_settings(cmd_settings) & list=lget('list'),& & show_model=lget('show-model'),& & build_tests=lget('tests'),& - & path_to_config=global_config, & + & path_to_config=config_file, & & verbose=lget('verbose'),& & token=token_s) @@ -1324,7 +1324,7 @@ subroutine set_help() '', & 'SYNOPSIS', & ' fpm update [--fetch-only] [--clean] [--verbose] [NAME(s)] ', & - ' [--global-config PATH] ', & + ' [--config-file PATH] ', & '', & 'DESCRIPTION', & ' Manage and update project dependencies. If no dependency names are', & @@ -1346,7 +1346,7 @@ subroutine set_help() 'SYNOPSIS', & ' fpm install [--profile PROF] [--flag FFLAGS] [--list] [--no-rebuild]', & ' [--prefix DIR] [--bindir DIR] [--libdir DIR] [--includedir DIR]', & - ' [--verbose] [--global-config PATH]', & + ' [--verbose] [--config-file PATH]', & '', & 'DESCRIPTION', & ' Subcommand to install fpm projects. Running install will export the', & @@ -1409,7 +1409,7 @@ subroutine set_help() '', & 'SYNOPSIS', & ' fpm publish [--token TOKEN] [--show-package-version] [--show-upload-data]', & - ' [--dry-run] [--verbose] [--global-config PATH]', & + ' [--dry-run] [--verbose] [--config-file PATH]', & '', & ' fpm publish --help|--version', & '', & From bfd3917ab2452b742aadbcb788842d2f9dfd171f Mon Sep 17 00:00:00 2001 From: Henil Panchal Date: Sat, 27 Apr 2024 13:57:55 +0530 Subject: [PATCH 05/13] test: --- src/fpm/downloader.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/downloader.f90 b/src/fpm/downloader.f90 index 39a3314ccf..4c19bf9f29 100644 --- a/src/fpm/downloader.f90 +++ b/src/fpm/downloader.f90 @@ -18,7 +18,7 @@ module fpm_downloader contains - !> Perform an http get request, save output to file, and parse json. + !> Perform an http get request, save output to file, and parse json. subroutine get_pkg_data(url, version, tmp_pkg_file, json, error) character(*), intent(in) :: url type(version_t), allocatable, intent(in) :: version From 8891280baff3c2ae7c4ff13152611b0774dabdeb Mon Sep 17 00:00:00 2001 From: Henil Panchal Date: Sat, 27 Apr 2024 14:40:36 +0530 Subject: [PATCH 06/13] fix: --- src/fpm_command_line.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 2a9567be50..b6851e1cef 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -663,7 +663,6 @@ subroutine get_command_line_settings(cmd_settings) cmd_settings=fpm_update_settings(name=names, & & fetch_only=lget('fetch-only'), & & dump=val_dump, & - & fetch_only=lget('fetch-only'), & & verbose=lget('verbose'), & & path_to_config=config_file, & & clean=lget('clean')) From 018ca7212108a288e5670cc67654c1eb1b9e7ee8 Mon Sep 17 00:00:00 2001 From: Henil Panchal Date: Sat, 27 Apr 2024 17:41:33 +0530 Subject: [PATCH 07/13] fix: --- src/fpm_command_line.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index b6851e1cef..3e77f5808e 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -708,7 +708,6 @@ subroutine get_command_line_settings(cmd_settings) block logical :: skip, clean_all - character(len=256) :: config_file skip = lget('skip') clean_all = lget('all') @@ -721,7 +720,6 @@ subroutine get_command_line_settings(cmd_settings) allocate(fpm_clean_settings :: cmd_settings) call get_current_directory(working_dir, error) cmd_settings = fpm_clean_settings( & - & is_unix=is_unix, & & calling_dir=working_dir, & & clean_skip=skip, & & clean_all=clean_all, & From 7e63a3ae28d4df6af9f666ad40f11f78eda00e35 Mon Sep 17 00:00:00 2001 From: Henil Panchal Date: Sat, 27 Apr 2024 17:43:56 +0530 Subject: [PATCH 08/13] fix: --- src/fpm_command_line.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 3e77f5808e..8fd8b31c30 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -720,7 +720,7 @@ subroutine get_command_line_settings(cmd_settings) allocate(fpm_clean_settings :: cmd_settings) call get_current_directory(working_dir, error) cmd_settings = fpm_clean_settings( & - & calling_dir=working_dir, & + & working_dir=working_dir, & & clean_skip=skip, & & clean_all=clean_all, & & path_to_config=config_file) From b5e6d6e5e909db24be826127ab8f66f43ef56bed Mon Sep 17 00:00:00 2001 From: Henil Panchal Date: Sat, 27 Apr 2024 17:47:30 +0530 Subject: [PATCH 09/13] fix: --- src/fpm/dependency.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 19d7c32648..24747b687a 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -60,7 +60,7 @@ module fpm_dependency use fpm_error, only: error_t, fatal_error use fpm_filesystem, only: exists, join_path, mkdir, canon_path, windows_path, list_files, is_dir, basename, & os_delete_dir, get_temp_filename, parent_dir - use fpm_git, only: git_target_revision, git_target_default, git_revision, operator(==), serializable_t + use fpm_git, only: git_target_revision, git_target_default, git_revision, serializable_t use fpm_manifest, only: package_config_t, dependency_config_t, get_package_data use fpm_manifest_dependency, only: manifest_has_changed, dependency_destroy use fpm_manifest_preprocess, only: operator(==) From 01c4224bae6e00f6cd50c7a11d99dc7268f9b8e3 Mon Sep 17 00:00:00 2001 From: Henil Panchal Date: Sat, 27 Apr 2024 19:21:10 +0530 Subject: [PATCH 10/13] fix: --- src/fpm_command_line.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 8fd8b31c30..29159ba36e 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -722,6 +722,7 @@ subroutine get_command_line_settings(cmd_settings) cmd_settings = fpm_clean_settings( & & working_dir=working_dir, & & clean_skip=skip, & + & registry_cache=lget('registry-cache'), & & clean_all=clean_all, & & path_to_config=config_file) end block From 3ca21767cb2446e8139e4d99371b0d936e6117e4 Mon Sep 17 00:00:00 2001 From: Henil Panchal Date: Sun, 5 May 2024 13:42:31 +0530 Subject: [PATCH 11/13] test --- src/fpm/git.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index a4f0f06a4a..d6b6ced291 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -446,7 +446,7 @@ subroutine git_archive(source, destination, ref, additional_files, verbose, erro & -o '//destination, & & echo=verbose, & & exitstat=stat) - + if (stat /= 0) then call fatal_error(error, "Error packing '"//source//"'."); return end if From f4a884400f5a1ddb43a9fe99b33cacddab3575b4 Mon Sep 17 00:00:00 2001 From: Henil Panchal Date: Sun, 5 May 2024 13:43:31 +0530 Subject: [PATCH 12/13] test --- src/fpm/git.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index d6b6ced291..a4f0f06a4a 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -446,7 +446,7 @@ subroutine git_archive(source, destination, ref, additional_files, verbose, erro & -o '//destination, & & echo=verbose, & & exitstat=stat) - + if (stat /= 0) then call fatal_error(error, "Error packing '"//source//"'."); return end if From 06e813716e4b9e13cb67966c9ca7fcc0580d6adc Mon Sep 17 00:00:00 2001 From: Henil Panchal Date: Mon, 6 May 2024 00:18:58 +0530 Subject: [PATCH 13/13] fix: url bug --- src/fpm/dependency.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 24747b687a..8df8caa182 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -717,7 +717,7 @@ subroutine get_from_registry(self, target_dir, global_settings, error, downloade end if ! Include namespace and package name in the target url and download package data. - target_url = global_settings%registry_settings%url//'packages/'//self%namespace//'/'//self%name + target_url = global_settings%registry_settings%url//'/packages/'//self%namespace//'/'//self%name call downloader%get_pkg_data(target_url, self%requested_version, tmp_file, json, error) close (unit, status='delete') if (allocated(error)) return