From 6ea99998e0ddf8c92212a839607cbbfc00ceba9a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 17:17:33 +0200 Subject: [PATCH 1/6] bump version to 0.8.2 --- fpm.toml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/fpm.toml b/fpm.toml index dcd3f27743..4aff58773c 100644 --- a/fpm.toml +++ b/fpm.toml @@ -1,9 +1,9 @@ name = "fpm" -version = "0.8.1" +version = "0.8.2" license = "MIT" author = "fpm maintainers" maintainer = "" -copyright = "2020 fpm contributors" +copyright = "2020-2023 fpm contributors" [preprocess] [preprocess.cpp] From 5a1656440089b1a7510517bb7807245707240665 Mon Sep 17 00:00:00 2001 From: gnikit Date: Sun, 14 May 2023 22:13:16 +0100 Subject: [PATCH 2/6] build: changed file ext to enable preprocessor (#911) lowercase file extension was preventing the copmiler (gfortran) to identify the existence of preprocessor definitions in the file and turn on preproc parsing. This caused issues downstream, during the creation of fpm PyPi wheels. Fixes #910 --- src/fpm/{fpm_release.f90 => fpm_release.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/fpm/{fpm_release.f90 => fpm_release.F90} (100%) diff --git a/src/fpm/fpm_release.f90 b/src/fpm/fpm_release.F90 similarity index 100% rename from src/fpm/fpm_release.f90 rename to src/fpm/fpm_release.F90 From 9ff449514d997965dd645439100ddce995c7002f Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 15 May 2023 20:13:30 +0700 Subject: [PATCH 3/6] Use get_tmp_filename --- src/fpm/cmd/publish.f90 | 13 ++++++------ src/fpm/git.f90 | 8 ++------ src/fpm_filesystem.F90 | 45 ++++++----------------------------------- 3 files changed, 14 insertions(+), 52 deletions(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index 09fc465272..dc83880f14 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -8,8 +8,8 @@ module fpm_cmd_publish use fpm_model, only: fpm_model_t use fpm_error, only: error_t, fpm_stop use fpm_versioning, only: version_t - use fpm_filesystem, only: exists, join_path, get_tmp_directory - use fpm_git, only: git_archive, compressed_package_name + use fpm_filesystem, only: exists, join_path, get_temp_filename + use fpm_git, only: git_archive use fpm_downloader, only: downloader_t use fpm_strings, only: string_t use fpm_settings, only: official_registry_base_url @@ -31,7 +31,7 @@ subroutine cmd_publish(settings) type(error_t), allocatable :: error type(version_t), allocatable :: version type(string_t), allocatable :: form_data(:) - character(len=:), allocatable :: tmpdir + character(len=:), allocatable :: tmp_file type(downloader_t) :: downloader integer :: i @@ -69,11 +69,10 @@ subroutine cmd_publish(settings) if (allocated(settings%token)) form_data = [form_data, string_t('upload_token="'//settings%token//'"')] - call get_tmp_directory(tmpdir, error) - if (allocated(error)) call fpm_stop(1, '*cmd_publish* Tmp directory error: '//error%message) - call git_archive('.', tmpdir, error) + tmp_file = get_temp_filename() + call git_archive('.', tmp_file, error) if (allocated(error)) call fpm_stop(1, '*cmd_publish* Pack error: '//error%message) - form_data = [form_data, string_t('tarball=@"'//join_path(tmpdir, compressed_package_name)//'"')] + form_data = [form_data, string_t('tarball=@"'//tmp_file//'"')] if (settings%show_form_data) then do i = 1, size(form_data) diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index be4b99bcf6..602516ea74 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -5,10 +5,7 @@ module fpm_git implicit none public :: git_target_t, git_target_default, git_target_branch, git_target_tag, git_target_revision, git_revision, & - & git_archive, git_matches_manifest, operator(==), compressed_package_name - - !> Name of the compressed package that is generated temporarily. - character(len=*), parameter :: compressed_package_name = 'compressed_package' + & git_archive, git_matches_manifest, operator(==) !> Possible git target type :: enum_descriptor @@ -326,8 +323,7 @@ subroutine git_archive(source, destination, error) call fatal_error(error, "Cannot find a suitable archive format for 'git archive'."); return end if - call execute_command_line('git archive HEAD --format='//archive_format//' -o '// & - & join_path(destination, compressed_package_name), exitstat=stat) + call execute_command_line('git archive HEAD --format='//archive_format//' -o '// destination, exitstat=stat) if (stat /= 0) then call fatal_error(error, "Error packing '"//source//"'."); return end if diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index c7b12a8b5e..4cfe571b6f 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -14,8 +14,7 @@ module fpm_filesystem public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, list_files, get_local_prefix, & mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file, fileopen, fileclose, & filewrite, warnwrite, parent_dir, is_hidden_file, read_lines, read_lines_expanded, which, run, & - LINE_BUFFER_LEN, os_delete_dir, is_absolute_path, env_variable, get_home, get_tmp_directory, & - execute_and_read_output + LINE_BUFFER_LEN, os_delete_dir, is_absolute_path, env_variable, get_home, execute_and_read_output integer, parameter :: LINE_BUFFER_LEN = 1000 #ifndef FPM_BOOTSTRAP @@ -1033,21 +1032,15 @@ subroutine execute_and_read_output(cmd, output, error, exitstat) integer, intent(out), optional :: exitstat integer :: cmdstat, unit, stat = 0 - character(len=:), allocatable :: cmdmsg, tmp_path + character(len=:), allocatable :: cmdmsg, tmp_file character(len=1000) :: output_line - call get_tmp_directory(tmp_path, error) - if (allocated(error)) return + tmp_file = get_temp_filename() - if (.not. exists(tmp_path)) call mkdir(tmp_path) - tmp_path = join_path(tmp_path, 'command_line_output') - call delete_file(tmp_path) - call filewrite(tmp_path, ['']) + call execute_command_line(cmd//' > '//tmp_file, exitstat=exitstat, cmdstat=cmdstat) + if (cmdstat /= 0) call fatal_error(error, '*run*: '//"Command failed: '"//cmd//"'. Message: '"//trim(cmdmsg)//"'.") - call execute_command_line(cmd//' > '//tmp_path, exitstat=exitstat, cmdstat=cmdstat) - if (cmdstat /= 0) call fpm_stop(1,'*run*: '//"Command failed: '"//cmd//"'. Message: '"//trim(cmdmsg)//"'.") - - open(unit, file=tmp_path, action='read', status='old') + open(newunit=unit, file=tmp_file, action='read', status='old') output = '' do read(unit, *, iostat=stat) output_line @@ -1056,30 +1049,4 @@ subroutine execute_and_read_output(cmd, output, error, exitstat) end do close(unit, status='delete') end - - !> Get system-dependent tmp directory. - subroutine get_tmp_directory(tmp_dir, error) - !> System-dependant tmp directory. - character(len=:), allocatable, intent(out) :: tmp_dir - !> Error to handle. - type(error_t), allocatable, intent(out) :: error - - tmp_dir = get_env('TMPDIR', '') - if (tmp_dir /= '') then - tmp_dir = tmp_dir//'fpm'; return - end if - - tmp_dir = get_env('TMP', '') - if (tmp_dir /= '') then - tmp_dir = tmp_dir//'fpm'; return - end if - - tmp_dir = get_env('TEMP', '') - if (tmp_dir /= '') then - tmp_dir = tmp_dir//'fpm'; return - end if - - call fatal_error(error, "Couldn't determine system temporary directory.") - end - end module fpm_filesystem From 6abbde187fc7028a3e5e69061e764658942338a3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 15 May 2023 11:27:44 -0500 Subject: [PATCH 4/6] fallback to 0.8.0 if install.sh fails to fetch github --- install.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/install.sh b/install.sh index 2edc239508..4243ba6266 100644 --- a/install.sh +++ b/install.sh @@ -73,9 +73,9 @@ fi LATEST_RELEASE=$(get_latest_release "fortran-lang/fpm" "$FETCH") +# Fallback to a latest known release if network timeout if [ -z "$LATEST_RELEASE" ]; then - echo "Could not fetch the latest release from GitHub. Install curl or wget, and ensure network connectivity." - exit 3 + LATEST_RELEASE="0.8.0" fi SOURCE_URL="https://github.com/fortran-lang/fpm/releases/download/v${LATEST_RELEASE}/fpm-${LATEST_RELEASE}.F90" From 40b0c355a740dd261cf2f65f53ebb884bd052ef9 Mon Sep 17 00:00:00 2001 From: Minh Dao <43783196+minhqdao@users.noreply.github.com> Date: Fri, 19 May 2023 15:11:53 +0700 Subject: [PATCH 5/6] Return char* instead of int (#914) Co-authored-by: minhqdao --- src/fpm_os.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_os.c b/src/fpm_os.c index 2d417a0695..49e1a4d5f4 100644 --- a/src/fpm_os.c +++ b/src/fpm_os.c @@ -5,7 +5,7 @@ /// @param resolved_path /// @param maxLength /// @return -int c_realpath(char* path, char* resolved_path, int maxLength) { +char* c_realpath(char* path, char* resolved_path, int maxLength) { // Checking macro in C because it doesn't work with gfortran on Windows, even // when exported manually. #ifndef _WIN32 From a3d689fb6f319afb09987bda1d0e59f66d71e9e0 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 21 May 2023 03:36:05 -0500 Subject: [PATCH 6/6] Fix failing tests with Intel compiler (#901) * error #7976: An allocatable dummy argument may only be argument associated with an allocatable actual argument. [S] * enforce Fortran standard to enable LHS reallocation * fix empty args * fix input namelist formats * fix SEGFAULT building fpm_publish_settings * Revert "fix SEGFAULT building fpm_publish_settings" This reverts commit e0c86d64f2af32b63d8c4790feca62a4506e30ac. * Revert "Revert "fix SEGFAULT building fpm_publish_settings"" This reverts commit aca4925c856afa6244b1c5f712225956490883aa. * Revert "fix empty args" This reverts commit 8f1a8f3ab28a988e7dcbe059c4bce658363af9ad. * fix test-manifest routine (segfault unallocated `flags`) * line too long * Revert "Revert "fix empty args"" This reverts commit 3d2907bc36a9cff28074c9df8deff804f380adaa. * Revert "Revert "Revert "fix SEGFAULT building fpm_publish_settings""" This reverts commit ff1e885ef7104c89b261ff3111f0fb31607cecf0. * make fpm_publish_settings work with both gfortran and intel * Update fpm_command_line.f90 * fix bus error returning string * fix unallocated variables in non-allocatable dummy arguments * fix more unallocated strings * check existing directory: intel compiler fix * fix join_path in dependency with root specified * more unallocated strings * fix ifort bug with extended `mock_dependency_tree_t` --- src/fpm/dependency.f90 | 35 ++++++------ src/fpm/git.f90 | 7 ++- src/fpm/manifest/dependency.f90 | 4 +- src/fpm/manifest/profiles.f90 | 60 ++++++++++----------- src/fpm_command_line.f90 | 12 ++--- src/fpm_compiler.F90 | 29 +++++++--- src/fpm_filesystem.F90 | 6 +++ src/fpm_settings.f90 | 30 ++++++++--- src/fpm_source_parsing.f90 | 14 ++--- src/fpm_sources.f90 | 19 +++++++ src/fpm_targets.f90 | 14 ++--- test/cli_test/cli_test.f90 | 20 +++---- test/fpm_test/test_manifest.f90 | 25 +++++---- test/fpm_test/test_os.f90 | 3 ++ test/fpm_test/test_package_dependencies.f90 | 29 +++++++++- 15 files changed, 201 insertions(+), 106 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 8beb8ae0db..600c43fdb2 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -719,40 +719,45 @@ subroutine check_and_read_pkg_data(json, node, download_url, version, error) integer :: code, stat type(json_object), pointer :: p, q - character(:), allocatable :: version_key, version_str, error_message + character(:), allocatable :: version_key, version_str, error_message, namespace, name + + namespace = "" + name = "UNNAMED_NODE" + if (allocated(node%namespace)) namespace = node%namespace + if (allocated(node%name)) name = node%name if (.not. json%has_key('code')) then - call fatal_error(error, "Failed to download '"//join_path(node%namespace, node%name)//"': No status code."); return + call fatal_error(error, "Failed to download '"//join_path(namespace, name)//"': No status code."); return end if call get_value(json, 'code', code, stat=stat) if (stat /= 0) then - call fatal_error(error, "Failed to download '"//join_path(node%namespace, node%name)//"': "// & + call fatal_error(error, "Failed to download '"//join_path(namespace, name)//"': "// & & "Failed to read status code."); return end if if (code /= 200) then if (.not. json%has_key('message')) then - call fatal_error(error, "Failed to download '"//join_path(node%namespace, node%name)//"': No error message."); return + call fatal_error(error, "Failed to download '"//join_path(namespace, name)//"': No error message."); return end if call get_value(json, 'message', error_message, stat=stat) if (stat /= 0) then - call fatal_error(error, "Failed to download '"//join_path(node%namespace, node%name)//"': "// & + call fatal_error(error, "Failed to download '"//join_path(namespace, name)//"': "// & & "Failed to read error message."); return end if - call fatal_error(error, "Failed to download '"//join_path(node%namespace, node%name)//"'. Status code: '"// & + call fatal_error(error, "Failed to download '"//join_path(namespace, name)//"'. Status code: '"// & & str(code)//"'. Error message: '"//error_message//"'."); return end if if (.not. json%has_key('data')) then - call fatal_error(error, "Failed to download '"//join_path(node%namespace, node%name)//"': No data."); return + call fatal_error(error, "Failed to download '"//join_path(namespace, name)//"': No data."); return end if call get_value(json, 'data', p, stat=stat) if (stat /= 0) then - call fatal_error(error, "Failed to read package data for '"//join_path(node%namespace, node%name)//"'."); return + call fatal_error(error, "Failed to read package data for '"//join_path(namespace, name)//"'."); return end if if (allocated(node%requested_version)) then @@ -762,38 +767,38 @@ subroutine check_and_read_pkg_data(json, node, download_url, version, error) end if if (.not. p%has_key(version_key)) then - call fatal_error(error, "Failed to download '"//join_path(node%namespace, node%name)//"': No version data."); return + call fatal_error(error, "Failed to download '"//join_path(namespace, name)//"': No version data."); return end if call get_value(p, version_key, q, stat=stat) if (stat /= 0) then - call fatal_error(error, "Failed to retrieve version data for '"//join_path(node%namespace, node%name)//"'."); return + call fatal_error(error, "Failed to retrieve version data for '"//join_path(namespace, name)//"'."); return end if if (.not. q%has_key('download_url')) then - call fatal_error(error, "Failed to download '"//join_path(node%namespace, node%name)//"': No download url."); return + call fatal_error(error, "Failed to download '"//join_path(namespace, name)//"': No download url."); return end if call get_value(q, 'download_url', download_url, stat=stat) if (stat /= 0) then - call fatal_error(error, "Failed to read download url for '"//join_path(node%namespace, node%name)//"'."); return + call fatal_error(error, "Failed to read download url for '"//join_path(namespace, name)//"'."); return end if download_url = official_registry_base_url//download_url if (.not. q%has_key('version')) then - call fatal_error(error, "Failed to download '"//join_path(node%namespace, node%name)//"': No version found."); return + call fatal_error(error, "Failed to download '"//join_path(namespace, name)//"': No version found."); return end if call get_value(q, 'version', version_str, stat=stat) if (stat /= 0) then - call fatal_error(error, "Failed to read version data for '"//join_path(node%namespace, node%name)//"'."); return + call fatal_error(error, "Failed to read version data for '"//join_path(namespace, name)//"'."); return end if call new_version(version, version_str, error) if (allocated(error)) then call fatal_error(error, "'"//version_str//"' is not a valid version for '"// & - & join_path(node%namespace, node%name)//"'."); return + & join_path(namespace, name)//"'."); return end if end subroutine diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index 602516ea74..b1cd1d8376 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -5,7 +5,10 @@ module fpm_git implicit none public :: git_target_t, git_target_default, git_target_branch, git_target_tag, git_target_revision, git_revision, & - & git_archive, git_matches_manifest, operator(==) + & git_archive, git_matches_manifest, operator(==), compressed_package_name + + !> Name of the compressed package that is generated temporarily. + character(len=*), parameter :: compressed_package_name = 'compressed_package' !> Possible git target type :: enum_descriptor @@ -162,6 +165,8 @@ logical function git_matches_manifest(cached,manifest,verbosity,iunit) !> while the cached dependency always stores a commit hash because it's built !> after the repo is available (saved as git_descriptor%revision==revision). !> So, comparing against the descriptor is not reliable + git_matches_manifest = allocated(cached%object) .eqv. allocated(manifest%object) + if (git_matches_manifest .and. allocated(cached%object)) & git_matches_manifest = cached%object == manifest%object if (.not.git_matches_manifest) then if (verbosity>1) write(iunit,out_fmt) "GIT OBJECT has changed: ",cached%object," vs. ", manifest%object diff --git a/src/fpm/manifest/dependency.f90 b/src/fpm/manifest/dependency.f90 index 1ca53bc9cf..3d8f38d840 100644 --- a/src/fpm/manifest/dependency.f90 +++ b/src/fpm/manifest/dependency.f90 @@ -27,7 +27,7 @@ module fpm_manifest_dependency use fpm_git, only: git_target_t, git_target_tag, git_target_branch, & & git_target_revision, git_target_default, operator(==), git_matches_manifest use fpm_toml, only: toml_table, toml_key, toml_stat, get_value, check_keys - use fpm_filesystem, only: windows_path + use fpm_filesystem, only: windows_path, join_path use fpm_environment, only: get_os_type, OS_WINDOWS use fpm_versioning, only: version_t, new_version implicit none @@ -94,7 +94,7 @@ subroutine new_dependency(self, table, root, error) call get_value(table, "path", uri) if (allocated(uri)) then if (get_os_type() == OS_WINDOWS) uri = windows_path(uri) - if (present(root)) uri = root//uri ! Relative to the fpm.toml it’s written in + if (present(root)) uri = join_path(root,uri) ! Relative to the fpm.toml it’s written in call move_alloc(uri, self%path) return end if diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index 2e84f0c6e9..8f1e82eaa5 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -53,7 +53,7 @@ module fpm_manifest_profile & info_profile, find_profile, DEFAULT_COMPILER !> Name of the default compiler - character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran' + character(len=*), parameter :: DEFAULT_COMPILER = 'gfortran' integer, parameter :: OS_ALL = -1 character(len=:), allocatable :: path @@ -78,7 +78,7 @@ module fpm_manifest_profile !> Value repesenting OS integer :: os_type - + !> Fortran compiler flags character(len=:), allocatable :: flags @@ -110,16 +110,16 @@ module fpm_manifest_profile function new_profile(profile_name, compiler, os_type, flags, c_flags, cxx_flags, & link_time_flags, file_scope_flags, is_built_in) & & result(profile) - + !> Name of the profile character(len=*), intent(in) :: profile_name - + !> Name of the compiler character(len=*), intent(in) :: compiler - + !> Type of the OS integer, intent(in) :: os_type - + !> Fortran compiler flags character(len=*), optional, intent(in) :: flags @@ -190,7 +190,7 @@ subroutine validate_compiler_name(compiler_name, is_valid) is_valid = .false. end select end subroutine validate_compiler_name - + !> Check if os_name is a valid name of a supported OS subroutine validate_os_name(os_name, is_valid) @@ -373,10 +373,10 @@ subroutine get_flags(profile_name, compiler_name, os_type, key_list, table, prof & flags, c_flags, cxx_flags, link_time_flags, file_scope_flags) profindex = profindex + 1 end subroutine get_flags - + !> Traverse operating system tables to obtain number of profiles subroutine traverse_oss_for_size(profile_name, compiler_name, os_list, table, profiles_size, error) - + !> Name of profile character(len=:), allocatable, intent(in) :: profile_name @@ -447,7 +447,7 @@ end subroutine traverse_oss_for_size !> Traverse operating system tables to obtain profiles subroutine traverse_oss(profile_name, compiler_name, os_list, table, profiles, profindex, error) - + !> Name of profile character(len=:), allocatable, intent(in) :: profile_name @@ -468,7 +468,7 @@ subroutine traverse_oss(profile_name, compiler_name, os_list, table, profiles, p !> Index in the list of profiles integer, intent(inout) :: profindex - + type(toml_key), allocatable :: key_list(:) character(len=:), allocatable :: os_name, l_os_name type(toml_table), pointer :: os_node @@ -513,7 +513,7 @@ end subroutine traverse_oss !> Traverse compiler tables subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_size, profiles, profindex) - + !> Name of profile character(len=:), allocatable, intent(in) :: profile_name @@ -522,10 +522,10 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si !> Table containing compiler tables type(toml_table), pointer, intent(in) :: table - + !> Error handling type(error_t), allocatable, intent(out) :: error - + !> Number of profiles in list of profiles integer, intent(inout), optional :: profiles_size @@ -534,8 +534,8 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si !> Index in the list of profiles integer, intent(inout), optional :: profindex - - character(len=:), allocatable :: compiler_name + + character(len=:), allocatable :: compiler_name type(toml_table), pointer :: comp_node type(toml_key), allocatable :: os_list(:) integer :: icomp, stat @@ -544,7 +544,7 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si if (size(comp_list)<1) return do icomp = 1, size(comp_list) call validate_compiler_name(comp_list(icomp)%key, is_valid) - if (is_valid) then + if (is_valid) then compiler_name = comp_list(icomp)%key call get_value(table, compiler_name, comp_node, stat=stat) if (stat /= toml_stat%success) then @@ -567,7 +567,7 @@ subroutine traverse_compilers(profile_name, comp_list, table, error, profiles_si else call fatal_error(error,'*traverse_compilers*:Error: Compiler name not specified or invalid.') end if - end do + end do end subroutine traverse_compilers !> Construct new profiles array from a TOML data structure @@ -596,9 +596,9 @@ subroutine new_profiles(profiles, table, error) default_profiles = get_default_profiles(error) if (allocated(error)) return call table%get_keys(prof_list) - + if (size(prof_list) < 1) return - + profiles_size = 0 do iprof = 1, size(prof_list) @@ -633,7 +633,7 @@ subroutine new_profiles(profiles, table, error) profiles_size = profiles_size + size(default_profiles) allocate(profiles(profiles_size)) - + do profindex=1, size(default_profiles) profiles(profindex) = default_profiles(profindex) end do @@ -719,25 +719,25 @@ function get_default_profiles(error) result(default_profiles) & 'ifort', & & OS_ALL, & & flags = ' -fp-model precise -pc64 -align all -error-limit 1 -reentrancy& - & threaded -nogen-interfaces -assume byterecl', & + & threaded -nogen-interfaces -assume byterecl -standard-semantics', & & is_built_in=.true.), & & new_profile('release', & & 'ifort', & & OS_WINDOWS, & & flags = ' /fp:precise /align:all /error-limit:1 /reentrancy:threaded& - & /nogen-interfaces /assume:byterecl', & + & /nogen-interfaces /assume:byterecl /standard-semantics', & & is_built_in=.true.), & & new_profile('release', & & 'ifx', & & OS_ALL, & & flags = ' -fp-model=precise -pc64 -align all -error-limit 1 -reentrancy& - & threaded -nogen-interfaces -assume byterecl', & + & threaded -nogen-interfaces -assume byterecl -standard-semantics', & & is_built_in=.true.), & & new_profile('release', & & 'ifx', & & OS_WINDOWS, & & flags = ' /fp:precise /align:all /error-limit:1 /reentrancy:threaded& - & /nogen-interfaces /assume:byterecl', & + & /nogen-interfaces /assume:byterecl /standard-semantics', & & is_built_in=.true.), & & new_profile('release', & &'nagfor', & @@ -775,28 +775,28 @@ function get_default_profiles(error) result(default_profiles) & new_profile('debug', & & 'ifort', & & OS_ALL, & - & flags = ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -traceback', & + & flags = ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -standard-semantics -traceback', & & is_built_in=.true.), & & new_profile('debug', & & 'ifort', & & OS_WINDOWS, & & flags = ' /warn:all /check:all /error-limit:1& - & /Od /Z7 /assume:byterecl /traceback', & + & /Od /Z7 /assume:byterecl /standard-semantics /traceback', & & is_built_in=.true.), & & new_profile('debug', & & 'ifx', & & OS_ALL, & - & flags = ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -traceback', & + & flags = ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -standard-semantics -traceback', & & is_built_in=.true.), & & new_profile('debug', & & 'ifx', & & OS_WINDOWS, & - & flags = ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl', & + & flags = ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl /standard-semantics', & & is_built_in=.true.), & & new_profile('debug', & & 'ifx', & & OS_WINDOWS, & - & flags = ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl', & + & flags = ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl /standard-semantics', & & is_built_in=.true.), & & new_profile('debug', & & 'lfortran', & diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 2601b5c63f..f7a0b1380d 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -218,10 +218,9 @@ subroutine get_command_line_settings(cmd_settings) integer :: os logical :: is_unix type(fpm_install_settings), allocatable :: install_settings - type(fpm_publish_settings), allocatable :: publish_settings type(version_t) :: version character(len=:), allocatable :: common_args, compiler_args, run_args, working_dir, & - & c_compiler, cxx_compiler, archiver, version_s + & c_compiler, cxx_compiler, archiver, version_s, token_s character(len=*), parameter :: fc_env = "FC", cc_env = "CC", ar_env = "AR", & & fflags_env = "FFLAGS", cflags_env = "CFLAGS", cxxflags_env = "CXXFLAGS", ldflags_env = "LDFLAGS", & @@ -633,8 +632,10 @@ subroutine get_command_line_settings(cmd_settings) c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') + token_s = sget('token') - allocate(publish_settings, source=fpm_publish_settings( & + allocate(fpm_publish_settings :: cmd_settings) + cmd_settings = fpm_publish_settings( & & show_package_version = lget('show-package-version'), & & show_form_data = lget('show-form-data'), & & profile=val_profile,& @@ -650,9 +651,8 @@ subroutine get_command_line_settings(cmd_settings) & list=lget('list'),& & show_model=lget('show-model'),& & build_tests=lget('tests'),& - & verbose=lget('verbose'))) - call get_char_arg(publish_settings%token, 'token') - call move_alloc(publish_settings, cmd_settings) + & verbose=lget('verbose'),& + & token=token_s) case default diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index 80edd73620..c093001e42 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -176,7 +176,8 @@ module fpm_compiler flag_intel_nogen = " -nogen-interfaces", & flag_intel_byterecl = " -assume byterecl", & flag_intel_free_form = " -free", & - flag_intel_fixed_form = " -fixed" + flag_intel_fixed_form = " -fixed", & + flag_intel_standard_compliance = " -standard-semantics" character(*), parameter :: & flag_intel_backtrace_win = " /traceback", & @@ -190,7 +191,8 @@ module fpm_compiler flag_intel_nogen_win = " /nogen-interfaces", & flag_intel_byterecl_win = " /assume:byterecl", & flag_intel_free_form_win = " /free", & - flag_intel_fixed_form_win = " /fixed" + flag_intel_fixed_form_win = " /fixed", & + flag_intel_standard_compliance_win = " /standard-semantics" character(*), parameter :: & flag_nag_coarray = " -coarray=single", & @@ -276,7 +278,8 @@ subroutine get_release_compile_flags(id, flags) flag_intel_limit//& flag_intel_pthread//& flag_intel_nogen//& - flag_intel_byterecl + flag_intel_byterecl//& + flag_intel_standard_compliance case(id_intel_classic_mac) flags = & @@ -285,7 +288,8 @@ subroutine get_release_compile_flags(id, flags) flag_intel_limit//& flag_intel_pthread//& flag_intel_nogen//& - flag_intel_byterecl + flag_intel_byterecl//& + flag_intel_standard_compliance case(id_intel_classic_windows) flags = & @@ -294,7 +298,8 @@ subroutine get_release_compile_flags(id, flags) flag_intel_limit_win//& flag_intel_pthread_win//& flag_intel_nogen_win//& - flag_intel_byterecl_win + flag_intel_byterecl_win//& + flag_intel_standard_compliance_win case(id_intel_llvm_nix) flags = & @@ -303,7 +308,8 @@ subroutine get_release_compile_flags(id, flags) flag_intel_limit//& flag_intel_pthread//& flag_intel_nogen//& - flag_intel_byterecl + flag_intel_byterecl//& + flag_intel_standard_compliance case(id_intel_llvm_windows) flags = & @@ -312,7 +318,8 @@ subroutine get_release_compile_flags(id, flags) flag_intel_limit_win//& flag_intel_pthread_win//& flag_intel_nogen_win//& - flag_intel_byterecl_win + flag_intel_byterecl_win//& + flag_intel_standard_compliance_win case(id_nag) flags = & @@ -376,7 +383,9 @@ subroutine get_debug_compile_flags(id, flags) flag_intel_limit//& flag_intel_debug//& flag_intel_byterecl//& + flag_intel_standard_compliance//& flag_intel_backtrace + case(id_intel_classic_mac) flags = & flag_intel_warn//& @@ -384,6 +393,7 @@ subroutine get_debug_compile_flags(id, flags) flag_intel_limit//& flag_intel_debug//& flag_intel_byterecl//& + flag_intel_standard_compliance//& flag_intel_backtrace case(id_intel_classic_windows) flags = & @@ -392,6 +402,7 @@ subroutine get_debug_compile_flags(id, flags) flag_intel_limit_win//& flag_intel_debug_win//& flag_intel_byterecl_win//& + flag_intel_standard_compliance_win//& flag_intel_backtrace_win case(id_intel_llvm_nix) flags = & @@ -400,6 +411,7 @@ subroutine get_debug_compile_flags(id, flags) flag_intel_limit//& flag_intel_debug//& flag_intel_byterecl//& + flag_intel_standard_compliance//& flag_intel_backtrace case(id_intel_llvm_windows) flags = & @@ -407,7 +419,8 @@ subroutine get_debug_compile_flags(id, flags) flag_intel_check_win//& flag_intel_limit_win//& flag_intel_debug_win//& - flag_intel_byterecl_win + flag_intel_byterecl_win//& + flag_intel_standard_compliance_win case(id_nag) flags = & flag_nag_debug//& diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 4cfe571b6f..4e3be56475 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -542,6 +542,12 @@ end subroutine list_files logical function exists(filename) result(r) character(len=*), intent(in) :: filename inquire(file=filename, exist=r) + + !> Directories are not files for the Intel compilers. If so, also use this compiler-dependent extension +#if defined(__INTEL_COMPILER) + if (.not.r) inquire(directory=filename, exist=r) +#endif + end function diff --git a/src/fpm_settings.f90 b/src/fpm_settings.f90 index 75fbb21d2b..0e01ac5768 100644 --- a/src/fpm_settings.f90 +++ b/src/fpm_settings.f90 @@ -56,8 +56,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(global_settings%path_to_config_folder)) then - call fatal_error(error, "Folder not found: '"//global_settings%path_to_config_folder//"'."); return + if (.not. exists(config_path(global_settings))) then + call fatal_error(error, "Folder not found: '"//config_path(global_settings)//"'."); return end if ! Throw error if the file doesn't exist. @@ -115,7 +115,7 @@ 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(global_settings%path_to_config_folder, & + global_settings%registry_settings%cache_path = join_path(config_path(global_settings), & & 'dependencies') end subroutine use_default_registry_settings @@ -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(global_settings%path_to_config_folder, path), & + call get_absolute_path(join_path(config_path(global_settings), path), & & global_settings%registry_settings%path, error) if (allocated(error)) return @@ -201,15 +201,15 @@ 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(global_settings%path_to_config_folder, cache_path) + cache_path = join_path(config_path(global_settings), 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(global_settings%path_to_config_folder, & - & 'dependencies') + global_settings%registry_settings%cache_path = join_path(config_path(global_settings), & + & 'dependencies') end if end subroutine get_registry_settings @@ -218,6 +218,8 @@ 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 !> The full path to the global config file. @@ -225,7 +227,19 @@ function full_path(self) result(result) class(fpm_global_settings), intent(in) :: self character(len=:), allocatable :: result - result = join_path(self%path_to_config_folder, self%config_file_name) + result = join_path(config_path(self), self%config_file_name) end function + !> The path to the global config directory. + function config_path(self) + class(fpm_global_settings), intent(in) :: self + character(len=:), allocatable :: config_path + + if (allocated(self%path_to_config_folder)) then + config_path = self%path_to_config_folder + else + config_path = "" + end if + end function config_path + end module fpm_settings diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 6d22ef4a6c..88c3fc5c10 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -123,7 +123,7 @@ function parse_f_source(f_filename,error) result(f_source) ! Detect exported C-API via bind(C) if (.not.inside_interface .and. & parse_subsequence(file_lines_lower(i)%s,'bind','(','c')) then - + do j=i,1,-1 if (index(file_lines_lower(j)%s,'function') > 0 .or. & @@ -302,7 +302,7 @@ function parse_f_source(f_filename,error) result(f_source) f_source%unit_type = FPM_UNIT_MODULE end if - if (.not.inside_module) then + if (.not.inside_module) then inside_module = .true. else ! Must have missed an end module statement (can't assume a pure module) @@ -341,7 +341,7 @@ function parse_f_source(f_filename,error) result(f_source) file_lines_lower(i)%s) return end if - + if (f_source%unit_type /= FPM_UNIT_PROGRAM) then f_source%unit_type = FPM_UNIT_SUBMODULE end if @@ -403,7 +403,7 @@ function parse_f_source(f_filename,error) result(f_source) ! (to check for code outside of modules) if (parse_sequence(file_lines_lower(i)%s,'end','module') .or. & parse_sequence(file_lines_lower(i)%s,'end','submodule')) then - + inside_module = .false. cycle @@ -460,7 +460,7 @@ function parse_c_source(c_filename,error) result(c_source) c_source%unit_type = FPM_UNIT_CHEADER - else if (str_ends_with(lower(c_filename), ".cpp")) then + else if (str_ends_with(lower(c_filename), ".cpp")) then c_source%unit_type = FPM_UNIT_CPPSOURCE @@ -542,6 +542,7 @@ function split_n(string,delims,n,stat) result(substring) if (n<1) then i = size(string_parts) + n if (i < 1) then + allocate(character(len=0) :: substring) ! ifort bus error otherwise stat = 1 return end if @@ -550,6 +551,7 @@ function split_n(string,delims,n,stat) result(substring) end if if (i>size(string_parts)) then + allocate(character(len=0) :: substring) ! ifort bus error otherwise stat = 1 return end if @@ -573,7 +575,7 @@ function parse_subsequence(string,t1,t2,t3,t4) result(found) found = .false. offset = 1 - do + do i = index(string(offset:),t1) diff --git a/src/fpm_sources.f90 b/src/fpm_sources.f90 index 68251e59e5..0165249f50 100644 --- a/src/fpm_sources.f90 +++ b/src/fpm_sources.f90 @@ -7,6 +7,7 @@ module fpm_sources use fpm_error, only: error_t use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM use fpm_filesystem, only: basename, canon_path, dirname, join_path, list_files, is_hidden_file +use fpm_environment, only: get_os_type,OS_WINDOWS use fpm_strings, only: lower, str_ends_with, string_t, operator(.in.) use fpm_source_parsing, only: parse_f_source, parse_c_source use fpm_manifest_executable, only: executable_config_t @@ -14,6 +15,7 @@ module fpm_sources private public :: add_sources_from_dir, add_executable_sources +public :: get_exe_name_with_suffix character(4), parameter :: fortran_suffixes(2) = [".f90", & ".f "] @@ -232,4 +234,21 @@ subroutine get_executable_source_dirs(exe_dirs,executables) end subroutine get_executable_source_dirs +!> Build an executable name with suffix. Safe routine that always returns an allocated string +function get_exe_name_with_suffix(source) result(suffixed) + type(srcfile_t), intent(in) :: source + character(len=:), allocatable :: suffixed + + if (allocated(source%exe_name)) then + if (get_os_type() == OS_WINDOWS) then + suffixed = source%exe_name//'.exe' + else + suffixed = source%exe_name + end if + else + suffixed = "" + endif + +end function get_exe_name_with_suffix + end module fpm_sources diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 9c2ccc07cd..2fa7c0df00 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -32,6 +32,7 @@ module fpm_targets use fpm_filesystem, only: dirname, join_path, canon_path use fpm_strings, only: string_t, operator(.in.), string_cat, fnv_1a, resize, lower, str_ends_with use fpm_compiler, only: get_macros +use fpm_sources, only: get_exe_name_with_suffix implicit none private @@ -194,7 +195,7 @@ subroutine build_target_list(targets,model) type(fpm_model_t), intent(inout), target :: model integer :: i, j, n_source, exe_type - character(:), allocatable :: xsuffix, exe_dir, compile_flags + character(:), allocatable :: exe_dir, compile_flags logical :: with_lib ! Check for empty build (e.g. header-only lib) @@ -206,11 +207,6 @@ subroutine build_target_list(targets,model) return end if - if (get_os_type() == OS_WINDOWS) then - xsuffix = '.exe' - else - xsuffix = '' - end if with_lib = any([((model%packages(j)%sources(i)%unit_scope == FPM_SCOPE_LIB, & i=1,size(model%packages(j)%sources)), & @@ -304,8 +300,7 @@ subroutine build_target_list(targets,model) call add_target(targets,package=model%packages(j)%name,type = FPM_TARGET_EXECUTABLE,& link_libraries = sources(i)%link_libraries, & - output_name = join_path(exe_dir, & - sources(i)%exe_name//xsuffix)) + output_name = join_path(exe_dir,get_exe_name_with_suffix(sources(i)))) associate(target => targets(size(targets))%ptr) @@ -876,7 +871,8 @@ subroutine resolve_target_linking(targets, model) call get_link_objects(target%link_objects,target,is_exe=.true.) - local_link_flags = model%link_flags + local_link_flags = "" + if (allocated(model%link_flags)) local_link_flags = model%link_flags target%link_flags = model%link_flags//" "//string_cat(target%link_objects," ") if (allocated(target%link_libraries)) then diff --git a/test/cli_test/cli_test.f90 b/test/cli_test/cli_test.f90 index 69fd433145..dfc94d4daa 100644 --- a/test/cli_test/cli_test.f90 +++ b/test/cli_test/cli_test.f90 @@ -68,15 +68,15 @@ program main 'CMD="test proj1 p2 project3 --profile release -- arg1 -x ""and a long one""", & &NAME="proj1","p2","project3",profile="release" ARGS="""arg1"" ""-x"" ""and a long one""", ', & -'CMD="build", NAME= profile="",ARGS="",', & -'CMD="build --profile release", NAME= profile="release",ARGS="",', & +'CMD="build", NAME=, profile="",ARGS="",', & +'CMD="build --profile release", NAME=, profile="release",ARGS="",', & -'CMD="clean", NAME= ARGS="",', & -'CMD="clean --skip", C_S=T, NAME= ARGS="",', & -'CMD="clean --all", C_A=T, NAME= ARGS="",', & -'CMD="publish --token abc --show-package-version", SHOW_V=T, NAME= token="abc",ARGS="",', & -'CMD="publish --token abc --show-form-data", SHOW_F_D=T, NAME= token="abc",ARGS="",', & -'CMD="publish --token abc", NAME= token="abc",ARGS="",', & +'CMD="clean", NAME=, ARGS="",', & +'CMD="clean --skip", C_S=T, NAME=, ARGS="",', & +'CMD="clean --all", C_A=T, NAME=, ARGS="",', & +'CMD="publish --token abc --show-package-version", SHOW_V=T, NAME=, token="abc",ARGS="",', & +'CMD="publish --token abc --show-form-data", SHOW_F_D=T, NAME=, token="abc",ARGS="",', & +'CMD="publish --token abc", NAME=, token="abc",ARGS="",', & ' ' ] character(len=256) :: readme(3) @@ -251,11 +251,11 @@ subroutine parse() type is (fpm_run_settings) act_profile=settings%profile act_name=settings%name - act_args=settings%args + if (allocated(settings%args)) act_args=settings%args type is (fpm_test_settings) act_profile=settings%profile act_name=settings%name - act_args=settings%args + 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 diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index cd2605f4e3..566c61283d 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -483,7 +483,7 @@ subroutine test_profiles(error) type(package_config_t) :: package character(len=*), parameter :: manifest = 'fpm-profiles.toml' integer :: unit - character(:), allocatable :: profile_name, compiler, flags + character(:), allocatable :: profile_name, compiler logical :: profile_found type(profile_config_t) :: chosen_profile @@ -536,8 +536,9 @@ subroutine test_profiles(error) profile_name = 'debug' compiler = 'ifort' call find_profile(package%profiles, profile_name, compiler, 3, profile_found, chosen_profile) - if (.not.(chosen_profile%flags.eq.' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl /traceback')) then - call test_failed(error, "Failed to load built-in profile"//flags) + if (.not.(chosen_profile%flags.eq.& + ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl /standard-semantics /traceback')) then + call test_failed(error, "Failed to load built-in profile "//profile_name) return end if @@ -1382,7 +1383,7 @@ subroutine test_macro_parsing(error) type(error_t), allocatable, intent(out) :: error type(package_config_t) :: package - character(:), allocatable :: temp_file + character(:), allocatable :: temp_file,pkg_ver integer :: unit integer(compiler_enum) :: id @@ -1401,7 +1402,9 @@ subroutine test_macro_parsing(error) if (allocated(error)) return - if (get_macros(id, package%preprocess(1)%macros, package%version%s()) /= " -DFOO -DBAR=2 -DVERSION=0.1.0") then + pkg_ver = package%version%s() + + if (get_macros(id, package%preprocess(1)%macros, pkg_ver) /= " -DFOO -DBAR=2 -DVERSION=0.1.0") then call test_failed(error, "Macros were not parsed correctly") end if @@ -1414,12 +1417,13 @@ subroutine test_macro_parsing_dependency(error) !> Error handling type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: macrosPackage, macrosDependency + character(len=:), allocatable :: macros_package, macros_dependency type(package_config_t) :: package, dependency character(:), allocatable :: toml_file_package character(:), allocatable :: toml_file_dependency + character(:), allocatable :: pkg_ver,dep_ver integer :: unit integer(compiler_enum) :: id @@ -1456,10 +1460,13 @@ subroutine test_macro_parsing_dependency(error) if (allocated(error)) return - macrosPackage = get_macros(id, package%preprocess(1)%macros, package%version%s()) - macrosDependency = get_macros(id, dependency%preprocess(1)%macros, dependency%version%s()) + pkg_ver = package%version%s() + dep_ver = dependency%version%s() + + macros_package = get_macros(id, package%preprocess(1)%macros, pkg_ver) + macros_dependency = get_macros(id, dependency%preprocess(1)%macros, dep_ver) - if (macrosPackage == macrosDependency) then + if (macros_package == macros_dependency) then call test_failed(error, "Macros of package and dependency should not be equal") end if diff --git a/test/fpm_test/test_os.f90 b/test/fpm_test/test_os.f90 index d573ac0b78..594aa937a5 100644 --- a/test/fpm_test/test_os.f90 +++ b/test/fpm_test/test_os.f90 @@ -91,6 +91,7 @@ subroutine tilde_correct_separator(error) end if call get_absolute_path('~'//separator, result, error) + if (allocated(error)) return call get_home(home, error) if (allocated(error)) return @@ -137,6 +138,7 @@ subroutine abs_path_root(error) if (os_is_unix()) then call get_absolute_path('/', result, error) + if (allocated(error)) return if (result /= '/') then call test_failed(error, "Result '"//result//"' doesn't equal input value: '/'"); return @@ -146,6 +148,7 @@ subroutine abs_path_root(error) home_path = home_drive//'\' call get_absolute_path(home_path, result, error) + if (allocated(error)) return if (result /= home_path) then call test_failed(error, "Result '"//result//"' doesn't equal input value: '"//home_path//"'"); return diff --git a/test/fpm_test/test_package_dependencies.f90 b/test/fpm_test/test_package_dependencies.f90 index 3c5b0ee021..75a1cb255c 100644 --- a/test/fpm_test/test_package_dependencies.f90 +++ b/test/fpm_test/test_package_dependencies.f90 @@ -8,7 +8,7 @@ module test_package_dependencies use fpm_dependency use fpm_manifest_dependency use fpm_toml - use fpm_settings, only: fpm_global_settings, get_registry_settings + use fpm_settings, only: fpm_global_settings, get_registry_settings, get_global_settings use fpm_downloader, only: downloader_t use fpm_versioning, only: version_t use jonquil, only: json_object, json_value, json_loads, cast_to_object @@ -245,7 +245,8 @@ subroutine test_add_dependencies(error) return end if - call deps%resolve(".", error) + ! Do not use polymorphic version due to Ifort issue + call resolve_dependencies(deps, ".", error) if (allocated(error)) return if (.not. deps%finished()) then @@ -1425,6 +1426,30 @@ subroutine resolve_dependency_once(self, dependency, global_settings, root, erro end subroutine resolve_dependency_once + !> Resolve all dependencies in the tree + subroutine resolve_dependencies(self, root, error) + !> Instance of the dependency tree + type(mock_dependency_tree_t), intent(inout) :: self + !> Current installation prefix + character(len=*), intent(in) :: root + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(fpm_global_settings) :: global_settings + integer :: ii + + call get_global_settings(global_settings, error) + if (allocated(error)) return + + do ii = 1, self%ndep + call resolve_dependency_once(self, self%dep(ii), global_settings, root, error) + if (allocated(error)) exit + end do + + if (allocated(error)) return + + end subroutine resolve_dependencies + subroutine delete_tmp_folder if (is_dir(tmp_folder)) call os_delete_dir(os_is_unix(), tmp_folder) end