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