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