From b937d646850054db2942e9f18e63a817c5f7eb4a Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 19 Jun 2023 01:10:21 +0700 Subject: [PATCH] Refactor --- src/fpm.f90 | 35 +++++++++++++------------- src/fpm/cmd/update.f90 | 6 ++--- src/fpm/dependency.f90 | 56 ++++++++++++++++++++---------------------- src/fpm_filesystem.F90 | 4 ++- src/fpm_settings.f90 | 55 ++++++++++++++++++++--------------------- 5 files changed, 76 insertions(+), 80 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index e8ad5f255f..9e82b91d97 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 @@ -324,7 +323,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 @@ -617,17 +616,19 @@ subroutine cmd_run(settings,test) call fpm_stop(stat(firsterror),'*cmd_run*:stopping due to failed executions') end if - endif + end if + 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 @@ -635,11 +636,9 @@ subroutine compact_list_all() exe_source => exe_target%dependencies(1)%ptr%source 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 end do @@ -648,15 +647,15 @@ 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 - enddo + 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 + end do write(stderr,*) end subroutine compact_list diff --git a/src/fpm/cmd/update.f90 b/src/fpm/cmd/update.f90 index e1bcb7326c..513e69599f 100644 --- a/src/fpm/cmd/update.f90 +++ b/src/fpm/cmd/update.f90 @@ -24,15 +24,13 @@ 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)) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 600c43fdb2..af6860a0ac 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -123,7 +123,9 @@ module fpm_dependency type(dependency_node_t), allocatable :: dep(:) !> Cache file character(len=:), allocatable :: cache + contains + !> Overload procedure to add new dependencies to the tree generic :: add => add_project, add_project_dependencies, add_dependencies, & add_dependency, add_dependency_node @@ -194,13 +196,9 @@ subroutine new_dependency_tree(self, verbosity, cache) 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 end subroutine new_dependency_tree @@ -311,15 +309,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 +441,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 +496,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 @@ -722,7 +720,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 +1197,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_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 0e01ac5768..fe4b0748fa 100644 --- a/src/fpm_settings.f90 +++ b/src/fpm_settings.f90 @@ -4,13 +4,14 @@ module fpm_settings use fpm_environment, only: os_is_unix use fpm_error, only: error_t, fatal_error use fpm_toml, only: toml_table, toml_error, toml_stat, get_value, toml_load, check_keys - use fpm_os, only: get_current_directory, change_directory, get_absolute_path, & - convert_to_absolute_path + use fpm_os, only: get_current_directory, change_directory, get_absolute_path, convert_to_absolute_path + implicit none private 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. @@ -20,7 +21,7 @@ module fpm_settings !> Registry configs. type(fpm_registry_settings), allocatable :: registry_settings contains - procedure :: has_custom_location, full_path + procedure :: has_custom_location, full_path, path_to_config_folder_or_empty end type type :: fpm_registry_settings @@ -56,8 +57,8 @@ subroutine get_global_settings(global_settings, error) ! Use custom path to the config file if it was specified. if (global_settings%has_custom_location()) then ! Throw error if folder doesn't exist. - if (.not. exists(config_path(global_settings))) then - call fatal_error(error, "Folder not found: '"//config_path(global_settings)//"'."); return + if (.not. exists(global_settings%path_to_config_folder)) then + call fatal_error(error, "Folder not found: '"//global_settings%path_to_config_folder//"'."); return end if ! Throw error if the file doesn't exist. @@ -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 @@ -105,8 +106,7 @@ subroutine get_global_settings(global_settings, error) else 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. @@ -115,9 +115,9 @@ subroutine use_default_registry_settings(global_settings) allocate (global_settings%registry_settings) global_settings%registry_settings%url = official_registry_base_url - global_settings%registry_settings%cache_path = join_path(config_path(global_settings), & + global_settings%registry_settings%cache_path = join_path(global_settings%path_to_config_folder_or_empty(), & & 'dependencies') - end subroutine use_default_registry_settings + end !> Read registry settings from the global config file. subroutine get_registry_settings(table, global_settings, error) @@ -155,7 +155,7 @@ subroutine get_registry_settings(table, global_settings, error) global_settings%registry_settings%path = path else ! Get canonical, absolute path on both Unix and Windows. - call get_absolute_path(join_path(config_path(global_settings), path), & + call get_absolute_path(join_path(global_settings%path_to_config_folder_or_empty(), path), & & global_settings%registry_settings%path, error) if (allocated(error)) return @@ -201,45 +201,44 @@ subroutine get_registry_settings(table, global_settings, error) if (.not. exists(cache_path)) call mkdir(cache_path) global_settings%registry_settings%cache_path = cache_path else - cache_path = join_path(config_path(global_settings), cache_path) + cache_path = join_path(global_settings%path_to_config_folder_or_empty(), cache_path) if (.not. exists(cache_path)) call mkdir(cache_path) ! Get canonical, absolute path on both Unix and Windows. call get_absolute_path(cache_path, global_settings%registry_settings%cache_path, 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(global_settings%path_to_config_folder_or_empty(), '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) + elemental 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) class(fpm_global_settings), intent(in) :: self character(len=:), allocatable :: result - result = join_path(config_path(self), self%config_file_name) - end function + result = join_path(self%path_to_config_folder_or_empty(), self%config_file_name) + end !> The path to the global config directory. - function config_path(self) + pure function path_to_config_folder_or_empty(self) class(fpm_global_settings), intent(in) :: self - character(len=:), allocatable :: config_path + character(len=:), allocatable :: path_to_config_folder_or_empty if (allocated(self%path_to_config_folder)) then - config_path = self%path_to_config_folder + path_to_config_folder_or_empty = self%path_to_config_folder else - config_path = "" + path_to_config_folder_or_empty = "" end if - end function config_path - -end module fpm_settings + end +end