From a5785048f3029dd861302754530eab5cb815e350 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 23 Mar 2023 09:30:20 +0100 Subject: [PATCH 001/304] Create `metapackage_t` base structure --- src/fpm_meta.f90 | 85 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 85 insertions(+) create mode 100644 src/fpm_meta.f90 diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 new file mode 100644 index 0000000000..82959564e4 --- /dev/null +++ b/src/fpm_meta.f90 @@ -0,0 +1,85 @@ +!># The fpm meta-package model +!> +!> This is a wrapper data type that encapsulate all pre-processing information +!> (compiler flags, linker libraries, etc.) required to correctly enable a package +!> to use a core library. +!> +!> +!>### Available core libraries +!> +!> - OpenMP +!> +!> @note Core libraries are enabled in the [build] section of the fpm.toml manifest +!> +!> +module fpm_meta +use fpm_strings, only: string_t +use fpm_error, only: error_t, fatal_error, syntax_error +implicit none + +private + +!> Type for describing a source file +type, public :: metapackage_t + + logical :: has_link_libraries = .false. + logical :: has_compiler_flags = .false. + + !> List of compiler flags and options to be added + type(string_t), allocatable :: fflags(:) + type(string_t), allocatable :: link_flags(:) + type(string_t), allocatable :: link_dirs(:) + + contains + + !> Clean metapackage structure + procedure :: destroy + + !> Initialize the metapackage structure from its given name + procedure :: new => init_from_name + + + +end type metapackage_t + +contains + +!> Clean the metapackage structure +elemental subroutine destroy(this) + class(metapackage_t), intent(inout) :: this + + this%has_link_libraries = .false. + this%has_compiler_flags = .false. + + if (allocated(this%fflags)) deallocate(this%fflags) + if (allocated(this%link_flags)) deallocate(this%link_flags) + if (allocated(this%link_dirs)) deallocate(this%link_dirs) + +end subroutine destroy + +!> Initialize a metapackage from the given name +subroutine init_from_name(this,name,error) + class(metapackage_t), intent(inout) :: this + character(*), intent(in) :: name + type(error_t), allocatable, intent(out) :: error + + !> Initialize metapackage by name + select case(name) + case("openmp"); call init_openmp(this,error) + case default + call syntax_error(error, "Metapackage "//name//" is not supported in [build]") + return + end select + +end subroutine init_from_name + +!> Initialize OpenMP +subroutine init_openmp(this,error) + class(metapackage_t), intent(inout) :: this + type(error_t), allocatable, intent(out) :: error + + call fatal_error(error,"OpenMP metapackage is not yet supported") + +end subroutine init_openmp + +end module fpm_meta From ba28423374c1935614d49c52011e4c8ab8cd361b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 23 Mar 2023 09:44:38 +0100 Subject: [PATCH 002/304] build config: introduce "openmp" flag and metapackages variable --- src/fpm/manifest/build.f90 | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index 8047dd045d..d4382bc709 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -13,6 +13,7 @@ module fpm_manifest_build use fpm_error, only : error_t, syntax_error, fatal_error use fpm_strings, only : string_t, len_trim, is_valid_module_prefix use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list + use fpm_meta, only : metapackage_t implicit none private @@ -34,6 +35,11 @@ module fpm_manifest_build logical :: module_naming = .false. type(string_t) :: module_prefix + !> Metapackages + !> @note when several metapackages are supported, this will need be generalized + logical :: openmp + type(metapackage_t), allocatable :: metapackages(:) + !> Libraries to link against type(string_t), allocatable :: link(:) @@ -119,6 +125,9 @@ subroutine new_build_config(self, table, error) end if + !> Metapackages: read all flags + call get_value(table, "openmp", self%openmp, .false., stat=stat) + call get_list(table, "link", self%link, error) if (allocated(error)) return @@ -153,6 +162,10 @@ subroutine check(table, error) case ("module-naming") continue + !> Supported metapackages + case ("openmp") + continue + case default call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in [build]") exit From 0c4cf387012fdb4748f56ae6327bc7229f162a0b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 23 Mar 2023 09:50:13 +0100 Subject: [PATCH 003/304] generate metapackages on new_build_config --- src/fpm/manifest/build.f90 | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index d4382bc709..aa34c9bf9a 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -128,6 +128,9 @@ subroutine new_build_config(self, table, error) !> Metapackages: read all flags call get_value(table, "openmp", self%openmp, .false., stat=stat) + !> Generate metapackages + if (self%openmp) call add_metapackage(self,"openmp",error); if (allocated(error)) return + call get_list(table, "link", self%link, error) if (allocated(error)) return @@ -136,6 +139,28 @@ subroutine new_build_config(self, table, error) end subroutine new_build_config + !> Initialize a metapackage configuration + subroutine add_metapackage(build,name,error) + type(build_config_t), intent(inout) :: build + character(*), intent(in) :: name + type(error_t), allocatable, intent(out) :: error + + type(metapackage_t) :: add_meta + + !> Create new metapackage + call add_meta%new(name,error); if (allocated(error)) return + + !> Add it to the list of metapackages + if (allocated(build%metapackages)) then + build%metapackages = [build%metapackages, add_meta] + else + build%metapackages = [add_meta] + end if + + return + + end subroutine add_metapackage + !> Check local schema for allowed entries subroutine check(table, error) From 008244651f0ae69d82fe2e162196f8e74011d75b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 23 Mar 2023 09:56:06 +0100 Subject: [PATCH 004/304] remove unused circular dependency from fpm_compiler.f90 --- src/fpm_compiler.F90 | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index dee49f9f90..2e82d902ee 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -41,7 +41,6 @@ module fpm_compiler use fpm_filesystem, only: join_path, basename, get_temp_filename, delete_file, unix_path, & & getline, run use fpm_strings, only: split, string_cat, string_t, str_ends_with, str_begins_with_str -use fpm_manifest, only : package_config_t use fpm_error, only: error_t implicit none public :: compiler_t, new_compiler, archiver_t, new_archiver, get_macros @@ -187,7 +186,7 @@ module fpm_compiler character(*), parameter :: & flag_lfortran_opt = " --fast" - + contains @@ -417,7 +416,7 @@ pure subroutine set_cpp_preprocessor_flags(id, flags) end subroutine set_cpp_preprocessor_flags -!> This function will parse and read the macros list and +!> This function will parse and read the macros list and !> return them as defined flags. function get_macros(id, macros_list, version) result(macros) integer(compiler_enum), intent(in) :: id @@ -427,7 +426,7 @@ function get_macros(id, macros_list, version) result(macros) character(len=:), allocatable :: macros character(len=:), allocatable :: macro_definition_symbol character(:), allocatable :: valued_macros(:) - + integer :: i @@ -450,10 +449,10 @@ function get_macros(id, macros_list, version) result(macros) end if do i = 1, size(macros_list) - + !> Split the macro name and value. call split(macros_list(i)%s, valued_macros, delimiters="=") - + if (size(valued_macros) > 1) then !> Check if the value of macro starts with '{' character. if (str_begins_with_str(trim(valued_macros(size(valued_macros))), "{")) then @@ -463,15 +462,15 @@ function get_macros(id, macros_list, version) result(macros) !> Check if the string contains "version" as substring. if (index(valued_macros(size(valued_macros)), "version") /= 0) then - + !> These conditions are placed in order to ensure proper spacing between the macros. macros = macros//macro_definition_symbol//trim(valued_macros(1))//'='//version cycle end if end if - end if + end if end if - + macros = macros//macro_definition_symbol//macros_list(i)%s end do @@ -794,7 +793,7 @@ subroutine new_compiler(self, fc, cc, cxx, echo, verbose) logical, intent(in) :: verbose self%id = get_compiler_id(fc) - + self%echo = echo self%verbose = verbose self%fc = fc From 24ced5a55ac94cdcffe8522c9f399f7b79fa8286 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 23 Mar 2023 10:27:46 +0100 Subject: [PATCH 005/304] add default openmp flags; return human-readable compiler name --- src/fpm_compiler.F90 | 50 ++++++++++++++++++++++++++++++++++++++------ 1 file changed, 44 insertions(+), 6 deletions(-) diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index 2e82d902ee..62aea27193 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -105,6 +105,8 @@ module fpm_compiler procedure :: is_unknown !> Enumerate libraries, based on compiler and platform procedure :: enumerate_libraries + !> Return compiler name + procedure :: name => compiler_name end type compiler_t @@ -139,14 +141,16 @@ module fpm_compiler flag_gnu_warn = " -Wall -Wextra -Wimplicit-interface", & flag_gnu_check = " -fcheck=bounds -fcheck=array-temps", & flag_gnu_limit = " -fmax-errors=1", & - flag_gnu_external = " -Wimplicit-interface" + flag_gnu_external = " -Wimplicit-interface", & + flag_gnu_openmp = " -fopenmp" character(*), parameter :: & flag_pgi_backslash = " -Mbackslash", & flag_pgi_traceback = " -traceback", & flag_pgi_debug = " -g", & flag_pgi_check = " -Mbounds -Mchkptr -Mchkstk", & - flag_pgi_warn = " -Minform=inform" + flag_pgi_warn = " -Minform=inform", & + flag_pgi_openmp = " -mp" character(*), parameter :: & flag_ibmxl_backslash = " -qnoescape" @@ -161,7 +165,8 @@ module fpm_compiler flag_intel_limit = " -error-limit 1", & flag_intel_pthread = " -reentrancy threaded", & flag_intel_nogen = " -nogen-interfaces", & - flag_intel_byterecl = " -assume byterecl" + flag_intel_byterecl = " -assume byterecl", & + flag_intel_openmp = " -qopenmp" character(*), parameter :: & flag_intel_backtrace_win = " /traceback", & @@ -173,7 +178,8 @@ module fpm_compiler flag_intel_limit_win = " /error-limit:1", & flag_intel_pthread_win = " /reentrancy:threaded", & flag_intel_nogen_win = " /nogen-interfaces", & - flag_intel_byterecl_win = " /assume:byterecl" + flag_intel_byterecl_win = " /assume:byterecl", & + flag_intel_openmp_win = " /Qopenmp" character(*), parameter :: & flag_nag_coarray = " -coarray=single", & @@ -181,10 +187,12 @@ module fpm_compiler flag_nag_check = " -C", & flag_nag_debug = " -g -O0", & flag_nag_opt = " -O4", & - flag_nag_backtrace = " -gline" + flag_nag_backtrace = " -gline", & + flag_nag_openmp = " -openmp" character(*), parameter :: & - flag_lfortran_opt = " --fast" + flag_lfortran_opt = " --fast", & + flag_lfortran_openmp = " --openmp" contains @@ -1015,5 +1023,35 @@ pure function debug_archiver(self) result(repr) repr = 'ar="'//self%ar//'"' end function debug_archiver +!> Return a compiler name string +type(string_t) function compiler_name(self) result(name) + !> Instance of the compiler object + class(compiler_t), intent(in) :: self + + select case (self%id) + case(id_gcc); name = string_t("gfortran") + case(id_f95); name = string_t("f95") + case(id_caf); name = string_t("caf") + case(id_intel_classic_nix); name = string_t("ifort") + case(id_intel_classic_mac); name = string_t("ifort") + case(id_intel_classic_windows); name = string_t("ifort") + case(id_intel_llvm_nix); name = string_t("ifx") + case(id_intel_llvm_windows); name = string_t("ifx") + case(id_intel_llvm_unknown); name = string_t("ifx") + case(id_pgi); name = string_t("pgfortran") + case(id_nvhpc); name = string_t("nvfortran") + case(id_nag); name = string_t("nagfor") + case(id_flang); name = string_t("flang") + case(id_flang_new); name = string_t("flang-new") + case(id_f18); name = string_t("f18") + case(id_ibmxl); name = string_t("xlf90") + case(id_cray); name = string_t("crayftn") + case(id_lahey); name = string_t("lfc") + case(id_lfortran); name = string_t("lFortran") + case default; name = string_t("invalid/unknown") + end select +end function compiler_name + + end module fpm_compiler From 222aa2a0a20d28b4c5eb4f1aa5e58973a762fa90 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 23 Mar 2023 10:30:20 +0100 Subject: [PATCH 006/304] remove built metapackages from the build config --- src/fpm/manifest/build.f90 | 28 +--------------------------- 1 file changed, 1 insertion(+), 27 deletions(-) diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index aa34c9bf9a..660cfa49a4 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -37,8 +37,7 @@ module fpm_manifest_build !> Metapackages !> @note when several metapackages are supported, this will need be generalized - logical :: openmp - type(metapackage_t), allocatable :: metapackages(:) + logical :: openmp = .false. !> Libraries to link against type(string_t), allocatable :: link(:) @@ -128,9 +127,6 @@ subroutine new_build_config(self, table, error) !> Metapackages: read all flags call get_value(table, "openmp", self%openmp, .false., stat=stat) - !> Generate metapackages - if (self%openmp) call add_metapackage(self,"openmp",error); if (allocated(error)) return - call get_list(table, "link", self%link, error) if (allocated(error)) return @@ -139,28 +135,6 @@ subroutine new_build_config(self, table, error) end subroutine new_build_config - !> Initialize a metapackage configuration - subroutine add_metapackage(build,name,error) - type(build_config_t), intent(inout) :: build - character(*), intent(in) :: name - type(error_t), allocatable, intent(out) :: error - - type(metapackage_t) :: add_meta - - !> Create new metapackage - call add_meta%new(name,error); if (allocated(error)) return - - !> Add it to the list of metapackages - if (allocated(build%metapackages)) then - build%metapackages = [build%metapackages, add_meta] - else - build%metapackages = [add_meta] - end if - - return - - end subroutine add_metapackage - !> Check local schema for allowed entries subroutine check(table, error) From 9854e2d3c5b6cd6ec46793a4daccaa9e1a4d7c16 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 23 Mar 2023 10:34:38 +0100 Subject: [PATCH 007/304] compiler name: make it `character(:), allocatable` --- src/fpm_compiler.F90 | 44 +++++++++++++++++++++++--------------------- 1 file changed, 23 insertions(+), 21 deletions(-) diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index 62aea27193..fe7e2bfa7a 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -1024,31 +1024,33 @@ pure function debug_archiver(self) result(repr) end function debug_archiver !> Return a compiler name string -type(string_t) function compiler_name(self) result(name) +pure function compiler_name(self) result(name) !> Instance of the compiler object class(compiler_t), intent(in) :: self + !> Representation as string + character(len=:), allocatable :: name select case (self%id) - case(id_gcc); name = string_t("gfortran") - case(id_f95); name = string_t("f95") - case(id_caf); name = string_t("caf") - case(id_intel_classic_nix); name = string_t("ifort") - case(id_intel_classic_mac); name = string_t("ifort") - case(id_intel_classic_windows); name = string_t("ifort") - case(id_intel_llvm_nix); name = string_t("ifx") - case(id_intel_llvm_windows); name = string_t("ifx") - case(id_intel_llvm_unknown); name = string_t("ifx") - case(id_pgi); name = string_t("pgfortran") - case(id_nvhpc); name = string_t("nvfortran") - case(id_nag); name = string_t("nagfor") - case(id_flang); name = string_t("flang") - case(id_flang_new); name = string_t("flang-new") - case(id_f18); name = string_t("f18") - case(id_ibmxl); name = string_t("xlf90") - case(id_cray); name = string_t("crayftn") - case(id_lahey); name = string_t("lfc") - case(id_lfortran); name = string_t("lFortran") - case default; name = string_t("invalid/unknown") + case(id_gcc); name = "gfortran" + case(id_f95); name = "f95" + case(id_caf); name = "caf" + case(id_intel_classic_nix); name = "ifort" + case(id_intel_classic_mac); name = "ifort" + case(id_intel_classic_windows); name = "ifort" + case(id_intel_llvm_nix); name = "ifx" + case(id_intel_llvm_windows); name = "ifx" + case(id_intel_llvm_unknown); name = "ifx" + case(id_pgi); name = "pgfortran" + case(id_nvhpc); name = "nvfortran" + case(id_nag); name = "nagfor" + case(id_flang); name = "flang" + case(id_flang_new); name = "flang-new" + case(id_f18); name = "f18" + case(id_ibmxl); name = "xlf90" + case(id_cray); name = "crayftn" + case(id_lahey); name = "lfc" + case(id_lfortran); name = "lFortran" + case default; name = "invalid/unknown" end select end function compiler_name From 59a9d73fe1c25f0ba7404020bd16f4aa809a2eb3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 23 Mar 2023 10:45:42 +0100 Subject: [PATCH 008/304] code openmp compiler flags --- src/fpm_meta.f90 | 68 +++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 59 insertions(+), 9 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 82959564e4..eeb325d213 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -15,6 +15,7 @@ module fpm_meta use fpm_strings, only: string_t use fpm_error, only: error_t, fatal_error, syntax_error +use fpm_compiler implicit none private @@ -23,10 +24,11 @@ module fpm_meta type, public :: metapackage_t logical :: has_link_libraries = .false. - logical :: has_compiler_flags = .false. + logical :: has_link_flags = .false. + logical :: has_build_flags = .false. !> List of compiler flags and options to be added - type(string_t), allocatable :: fflags(:) + type(string_t), allocatable :: flags(:) type(string_t), allocatable :: link_flags(:) type(string_t), allocatable :: link_dirs(:) @@ -49,23 +51,25 @@ elemental subroutine destroy(this) class(metapackage_t), intent(inout) :: this this%has_link_libraries = .false. - this%has_compiler_flags = .false. + this%has_link_flags = .false. + this%has_build_flags = .false. - if (allocated(this%fflags)) deallocate(this%fflags) + if (allocated(this%flags)) deallocate(this%flags) if (allocated(this%link_flags)) deallocate(this%link_flags) if (allocated(this%link_dirs)) deallocate(this%link_dirs) end subroutine destroy !> Initialize a metapackage from the given name -subroutine init_from_name(this,name,error) +subroutine init_from_name(this,name,compiler,error) class(metapackage_t), intent(inout) :: this character(*), intent(in) :: name + type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error !> Initialize metapackage by name select case(name) - case("openmp"); call init_openmp(this,error) + case("openmp"); call init_openmp(this,compiler,error) case default call syntax_error(error, "Metapackage "//name//" is not supported in [build]") return @@ -73,12 +77,58 @@ subroutine init_from_name(this,name,error) end subroutine init_from_name -!> Initialize OpenMP -subroutine init_openmp(this,error) +!> Initialize OpenMP metapackage for the current system +subroutine init_openmp(this,compiler,error) class(metapackage_t), intent(inout) :: this + type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error - call fatal_error(error,"OpenMP metapackage is not yet supported") + character(:), allocatable :: flags + + !> Cleanup + call destroy(this) + + !> OpenMP has compiler flags + this%has_build_flags = .true. + this%has_link_flags = .true. + + !> OpenMP flags should be added to + which_compiler: select case (compiler%id) + case (id_gcc,id_f95) + this%flags = [string_t(flag_gnu_openmp)] + this%link_flags = [string_t(flag_gnu_openmp)] + + case (id_intel_classic_windows,id_intel_llvm_windows) + this%flags = [string_t(flag_intel_openmp_win)] + this%link_flags = [string_t(flag_intel_openmp_win)] + + case (id_intel_classic_nix,id_intel_classic_mac,& + id_intel_llvm_nix) + this%flags = [string_t(flag_intel_openmp)] + this%link_flags = [string_t(flag_intel_openmp)] + + case (id_pgi,id_nvhpc) + this%flags = [string_t(flag_pgi_openmp)] + this%link_flags = [string_t(flag_pgi_openmp)] + + case (id_ibmxl) + this%flags = [string_t(" -qsmp=omp")] + this%link_flags = [string_t(" -qsmp=omp")] + + case (id_nag) + this%flags = [string_t(flag_nag_openmp)] + this%link_flags = [string_t(flag_nag_openmp)] + + case (id_lfortran) + this%flags = [string_t(flag_lfortran_openmp)] + this%link_flags = [string_t(flag_lfortran_openmp)] + + case default + + call fatal_error(error,'openmp not supported on compiler '//compiler%name()//' yet') + + end select which_compiler + end subroutine init_openmp From 53799ab99946fb2231ed7fc0a72df3478b65bd1b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 23 Mar 2023 11:15:18 +0100 Subject: [PATCH 009/304] basic metapackage resolution --- src/fpm/manifest/build.f90 | 1 - src/fpm_meta.f90 | 93 ++++++++++++++++++++++++++++++-------- 2 files changed, 73 insertions(+), 21 deletions(-) diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index 660cfa49a4..cc25647fca 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -13,7 +13,6 @@ module fpm_manifest_build use fpm_error, only : error_t, syntax_error, fatal_error use fpm_strings, only : string_t, len_trim, is_valid_module_prefix use fpm_toml, only : toml_table, toml_key, toml_stat, get_value, get_list - use fpm_meta, only : metapackage_t implicit none private diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index eeb325d213..00dc745c87 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -16,21 +16,26 @@ module fpm_meta use fpm_strings, only: string_t use fpm_error, only: error_t, fatal_error, syntax_error use fpm_compiler +use fpm_model implicit none private +public :: add_metapackage + !> Type for describing a source file type, public :: metapackage_t logical :: has_link_libraries = .false. logical :: has_link_flags = .false. logical :: has_build_flags = .false. + logical :: has_include_dirs = .false. !> List of compiler flags and options to be added - type(string_t), allocatable :: flags(:) - type(string_t), allocatable :: link_flags(:) + type(string_t) :: flags + type(string_t) :: link_flags type(string_t), allocatable :: link_dirs(:) + type(string_t), allocatable :: link_libs(:) contains @@ -40,6 +45,9 @@ module fpm_meta !> Initialize the metapackage structure from its given name procedure :: new => init_from_name + !> Add metapackage dependencies to the model + procedure :: resolve + end type metapackage_t @@ -53,10 +61,12 @@ elemental subroutine destroy(this) this%has_link_libraries = .false. this%has_link_flags = .false. this%has_build_flags = .false. + this%has_include_dirs = .false. - if (allocated(this%flags)) deallocate(this%flags) - if (allocated(this%link_flags)) deallocate(this%link_flags) + if (allocated(this%flags%s)) deallocate(this%flags%s) + if (allocated(this%link_flags%s)) deallocate(this%link_flags%s) if (allocated(this%link_dirs)) deallocate(this%link_dirs) + if (allocated(this%link_libs)) deallocate(this%link_libs) end subroutine destroy @@ -83,8 +93,6 @@ subroutine init_openmp(this,compiler,error) type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error - character(:), allocatable :: flags - !> Cleanup call destroy(this) @@ -95,33 +103,33 @@ subroutine init_openmp(this,compiler,error) !> OpenMP flags should be added to which_compiler: select case (compiler%id) case (id_gcc,id_f95) - this%flags = [string_t(flag_gnu_openmp)] - this%link_flags = [string_t(flag_gnu_openmp)] + this%flags = string_t(flag_gnu_openmp) + this%link_flags = string_t(flag_gnu_openmp) case (id_intel_classic_windows,id_intel_llvm_windows) - this%flags = [string_t(flag_intel_openmp_win)] - this%link_flags = [string_t(flag_intel_openmp_win)] + this%flags = string_t(flag_intel_openmp_win) + this%link_flags = string_t(flag_intel_openmp_win) case (id_intel_classic_nix,id_intel_classic_mac,& id_intel_llvm_nix) - this%flags = [string_t(flag_intel_openmp)] - this%link_flags = [string_t(flag_intel_openmp)] + this%flags = string_t(flag_intel_openmp) + this%link_flags = string_t(flag_intel_openmp) case (id_pgi,id_nvhpc) - this%flags = [string_t(flag_pgi_openmp)] - this%link_flags = [string_t(flag_pgi_openmp)] + this%flags = string_t(flag_pgi_openmp) + this%link_flags = string_t(flag_pgi_openmp) case (id_ibmxl) - this%flags = [string_t(" -qsmp=omp")] - this%link_flags = [string_t(" -qsmp=omp")] + this%flags = string_t(" -qsmp=omp") + this%link_flags = string_t(" -qsmp=omp") case (id_nag) - this%flags = [string_t(flag_nag_openmp)] - this%link_flags = [string_t(flag_nag_openmp)] + this%flags = string_t(flag_nag_openmp) + this%link_flags = string_t(flag_nag_openmp) case (id_lfortran) - this%flags = [string_t(flag_lfortran_openmp)] - this%link_flags = [string_t(flag_lfortran_openmp)] + this%flags = string_t(flag_lfortran_openmp) + this%link_flags = string_t(flag_lfortran_openmp) case default @@ -132,4 +140,49 @@ subroutine init_openmp(this,compiler,error) end subroutine init_openmp +! Resolve metapackage dependencies into the model +subroutine resolve(self,model,error) + class(metapackage_t), intent(in) :: self + type(fpm_model_t), intent(inout) :: model + type(error_t), allocatable, intent(out) :: error + + ! For now, additional flags are assumed to apply to all sources + if (self%has_build_flags) then + model%fortran_compile_flags = model%fortran_compile_flags//self%flags%s + model%c_compile_flags = model%c_compile_flags//self%flags%s + model%cxx_compile_flags = model%cxx_compile_flags//self%flags%s + endif + + if (self%has_link_flags) then + model%link_flags = model%link_flags//self%link_flags%s + end if + + if (self%has_link_libraries) then + model%link_libraries = [model%link_libraries,self%link_libs] + end if + + if (self%has_include_dirs) then + model%include_dirs = [model%include_dirs,self%link_dirs] + end if + +end subroutine resolve + +! Add named metapackage dependency to the model +subroutine add_metapackage(model,name,error) + type(fpm_model_t), intent(inout) :: model + character(*), intent(in) :: name + type(error_t), allocatable, intent(out) :: error + + type(metapackage_t) :: meta + + !> Init metapackage + call meta%new(name,model%compiler,error) + if (allocated(error)) return + + !> Add it to the model + call meta%resolve(model,error) + if (allocated(error)) return + +end subroutine add_metapackage + end module fpm_meta From 02923637d8f821e46067759ad69b9fb32c3b1942 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 23 Mar 2023 11:15:33 +0100 Subject: [PATCH 010/304] openmp metapackage is now resolved --- src/fpm.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/fpm.f90 b/src/fpm.f90 index 51a1bb16f5..82c97758db 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -21,6 +21,7 @@ module fpm resolve_target_linking, build_target_t, build_target_ptr, & FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE use fpm_manifest, only : get_package_data, package_config_t +use fpm_meta, only : add_metapackage use fpm_error, only : error_t, fatal_error, fpm_stop use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & @@ -175,6 +176,10 @@ subroutine build_model(model, settings, package, error) model%cxx_compile_flags = cxxflags model%link_flags = ldflags + ! Build and resolve metapackage dependencies + if (package%build%openmp) call add_metapackage(model,"openmp",error) + if (allocated(error)) return + ! Add sources from executable directories if (is_dir('app') .and. package%build%auto_executables) then call add_sources_from_dir(model%packages(1)%sources,'app', FPM_SCOPE_APP, & From 7312a99ccbf2bdb18067da8e99ffc2b1a9daffcb Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 23 Mar 2023 11:16:21 +0100 Subject: [PATCH 011/304] add openmp example program --- example_packages/metapackage_openmp/README.md | 4 ++++ example_packages/metapackage_openmp/app/main.f90 | 16 ++++++++++++++++ example_packages/metapackage_openmp/fpm.toml | 13 +++++++++++++ .../metapackage_openmp/src/test_openmp.f90 | 11 +++++++++++ .../metapackage_openmp/test/check.f90 | 5 +++++ 5 files changed, 49 insertions(+) create mode 100644 example_packages/metapackage_openmp/README.md create mode 100644 example_packages/metapackage_openmp/app/main.f90 create mode 100644 example_packages/metapackage_openmp/fpm.toml create mode 100644 example_packages/metapackage_openmp/src/test_openmp.f90 create mode 100644 example_packages/metapackage_openmp/test/check.f90 diff --git a/example_packages/metapackage_openmp/README.md b/example_packages/metapackage_openmp/README.md new file mode 100644 index 0000000000..e191664959 --- /dev/null +++ b/example_packages/metapackage_openmp/README.md @@ -0,0 +1,4 @@ +# test_openmp +This test program prints the running thread ID using OpenMP. +Module omp_lib is invoked, so, this code cannot build if the OpenMP library +is not properly enabled by the compiler flags. diff --git a/example_packages/metapackage_openmp/app/main.f90 b/example_packages/metapackage_openmp/app/main.f90 new file mode 100644 index 0000000000..21b0aef90f --- /dev/null +++ b/example_packages/metapackage_openmp/app/main.f90 @@ -0,0 +1,16 @@ +! OpenMP test case +! This test program will only run if openmp is properly enabled in the compiler flags. +! Otherwise, the omp_lib module won't be found and the code cannot be built. +program openmp_test + use test_openmp, only: say_hello + use omp_lib + implicit none + +!$omp parallel + call say_hello(thread_ID=OMP_GET_THREAD_NUM()) +!$omp end parallel + +! Successful return +stop 0 + +end program openmp_test diff --git a/example_packages/metapackage_openmp/fpm.toml b/example_packages/metapackage_openmp/fpm.toml new file mode 100644 index 0000000000..92105e5d8c --- /dev/null +++ b/example_packages/metapackage_openmp/fpm.toml @@ -0,0 +1,13 @@ +name = "test_openmp" +version = "0.1.0" +license = "license" +author = "Federico Perini" +maintainer = "federico.perini@hello.world" +copyright = "Copyright 2023, Federico Perini and the fpm maintainers" +[build] +auto-executables = true +auto-tests = true +auto-examples = true +openmp = true +[install] +library = false diff --git a/example_packages/metapackage_openmp/src/test_openmp.f90 b/example_packages/metapackage_openmp/src/test_openmp.f90 new file mode 100644 index 0000000000..d83b4b1605 --- /dev/null +++ b/example_packages/metapackage_openmp/src/test_openmp.f90 @@ -0,0 +1,11 @@ +module test_openmp + implicit none + private + + public :: say_hello +contains + subroutine say_hello(thread_ID) + integer, intent(in) :: thread_ID + print "(a,i0,a)", "Hello, test_openmp is called from thread ",thread_ID,"!" + end subroutine say_hello +end module test_openmp diff --git a/example_packages/metapackage_openmp/test/check.f90 b/example_packages/metapackage_openmp/test/check.f90 new file mode 100644 index 0000000000..d7e3cba687 --- /dev/null +++ b/example_packages/metapackage_openmp/test/check.f90 @@ -0,0 +1,5 @@ +program check +implicit none + +print *, "Put some tests in here!" +end program check From 62bc5734c138d0493b94e27707593312e8f854ac Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 23 Mar 2023 11:21:12 +0100 Subject: [PATCH 012/304] add openmp test to CI --- ci/run_tests.sh | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index ddbd3af9b2..2f46b0f0de 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -193,6 +193,13 @@ EXIT_CODE=0 test $EXIT_CODE -eq 1 popd +# Test metapackages +pushd metapackage_openmp +"$fpm" build +EXIT_CODE=0 +"$fpm" run || EXIT_CODE=$? +test $EXIT_CODE -eq 0 +popd # Cleanup rm -rf ./*/build From 19dd707e2f7bb378ee2033f4265f2e5059799f6c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 30 Mar 2023 08:42:42 +0200 Subject: [PATCH 013/304] add `stdlib` support flag --- src/fpm.f90 | 4 ++++ src/fpm/manifest/build.f90 | 17 ++++++++++++++++- src/fpm_meta.f90 | 15 +++++++++++++++ 3 files changed, 35 insertions(+), 1 deletion(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 82c97758db..060abd5b38 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -180,6 +180,10 @@ subroutine build_model(model, settings, package, error) if (package%build%openmp) call add_metapackage(model,"openmp",error) if (allocated(error)) return + ! Stdlib is available but not implemented yet + if (package%build%stdlib) call fatal_error(error,"stdlib is not implemented yet") + if (allocated(error)) return + ! Add sources from executable directories if (is_dir('app') .and. package%build%auto_executables) then call add_sources_from_dir(model%packages(1)%sources,'app', FPM_SCOPE_APP, & diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index cc25647fca..3d505b93a2 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -36,8 +36,13 @@ module fpm_manifest_build !> Metapackages !> @note when several metapackages are supported, this will need be generalized + + !> Request OpenMP support logical :: openmp = .false. + !> Request stdlib support + logical :: stdlib = .false. + !> Libraries to link against type(string_t), allocatable :: link(:) @@ -125,6 +130,16 @@ subroutine new_build_config(self, table, error) !> Metapackages: read all flags call get_value(table, "openmp", self%openmp, .false., stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'openmp' in fpm.toml, expecting logical") + return + end if + + call get_value(table, "stdlib", self%stdlib, .false., stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'stdlib' in fpm.toml, expecting logical") + return + end if call get_list(table, "link", self%link, error) if (allocated(error)) return @@ -161,7 +176,7 @@ subroutine check(table, error) continue !> Supported metapackages - case ("openmp") + case ("openmp","stdlib") continue case default diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 00dc745c87..21844a5a59 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -80,6 +80,7 @@ subroutine init_from_name(this,name,compiler,error) !> Initialize metapackage by name select case(name) case("openmp"); call init_openmp(this,compiler,error) + case("stdlib"); call init_stdlib(this,compiler,error) case default call syntax_error(error, "Metapackage "//name//" is not supported in [build]") return @@ -140,6 +141,20 @@ subroutine init_openmp(this,compiler,error) end subroutine init_openmp +!> Initialize stdlib metapackage for the current system +subroutine init_stdlib(this,compiler,error) + class(metapackage_t), intent(inout) :: this + type(compiler_t), intent(in) :: compiler + type(error_t), allocatable, intent(out) :: error + + !> Cleanup + call destroy(this) + + !> Not implemented yet + call fatal_error(error,'stdlib not supported yet') + +end subroutine init_stdlib + ! Resolve metapackage dependencies into the model subroutine resolve(self,model,error) class(metapackage_t), intent(in) :: self From 0bcad127b27bf44d63804623a091131350975e5e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 30 Mar 2023 08:55:43 +0200 Subject: [PATCH 014/304] metapackage_t: add support for dependencies/dev-dependencies --- src/fpm_meta.f90 | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 21844a5a59..7993b85a53 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -26,10 +26,12 @@ module fpm_meta !> Type for describing a source file type, public :: metapackage_t - logical :: has_link_libraries = .false. - logical :: has_link_flags = .false. - logical :: has_build_flags = .false. - logical :: has_include_dirs = .false. + logical :: has_link_libraries = .false. + logical :: has_link_flags = .false. + logical :: has_build_flags = .false. + logical :: has_include_dirs = .false. + logical :: has_dependencies = .false. + logical :: has_dev_depenencies = .false. !> List of compiler flags and options to be added type(string_t) :: flags @@ -37,6 +39,12 @@ module fpm_meta type(string_t), allocatable :: link_dirs(:) type(string_t), allocatable :: link_libs(:) + !> List of Dependency meta data + type(dependency_config_t), allocatable :: dependency(:) + + !> List of Development dependency meta data + type(dependency_config_t), allocatable :: dev_dependency(:) + contains !> Clean metapackage structure @@ -58,15 +66,19 @@ module fpm_meta elemental subroutine destroy(this) class(metapackage_t), intent(inout) :: this - this%has_link_libraries = .false. - this%has_link_flags = .false. - this%has_build_flags = .false. - this%has_include_dirs = .false. + this%has_link_libraries = .false. + this%has_link_flags = .false. + this%has_build_flags = .false. + this%has_include_dirs = .false. + this%has_dependencies = .false. + this%has_dev_depenencies = .false. if (allocated(this%flags%s)) deallocate(this%flags%s) if (allocated(this%link_flags%s)) deallocate(this%link_flags%s) if (allocated(this%link_dirs)) deallocate(this%link_dirs) if (allocated(this%link_libs)) deallocate(this%link_libs) + if (allocated(this%dependency)) deallocate(this%dependency) + if (allocated(this%dev_dependency)) deallocate(this%dev_dependency) end subroutine destroy From 2f377b186799c6405ca46fec513012e013576a68 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 30 Mar 2023 08:56:45 +0200 Subject: [PATCH 015/304] fix use --- src/fpm_meta.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 7993b85a53..a7f5a3ad98 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -17,6 +17,7 @@ module fpm_meta use fpm_error, only: error_t, fatal_error, syntax_error use fpm_compiler use fpm_model +use fpm_manifest_dependency, only: dependency_config_t implicit none private From 3cf0000d36a976394576cb01776c9dbcba06f5e3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 30 Mar 2023 08:59:16 +0200 Subject: [PATCH 016/304] metapackage dependencies are all dev-dependencies --- src/fpm_meta.f90 | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index a7f5a3ad98..4569f95e5b 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -32,7 +32,6 @@ module fpm_meta logical :: has_build_flags = .false. logical :: has_include_dirs = .false. logical :: has_dependencies = .false. - logical :: has_dev_depenencies = .false. !> List of compiler flags and options to be added type(string_t) :: flags @@ -40,12 +39,10 @@ module fpm_meta type(string_t), allocatable :: link_dirs(:) type(string_t), allocatable :: link_libs(:) - !> List of Dependency meta data + !> List of Development dependency meta data. + !> Metapackage dependencies are never exported from the model type(dependency_config_t), allocatable :: dependency(:) - !> List of Development dependency meta data - type(dependency_config_t), allocatable :: dev_dependency(:) - contains !> Clean metapackage structure @@ -72,14 +69,12 @@ elemental subroutine destroy(this) this%has_build_flags = .false. this%has_include_dirs = .false. this%has_dependencies = .false. - this%has_dev_depenencies = .false. if (allocated(this%flags%s)) deallocate(this%flags%s) if (allocated(this%link_flags%s)) deallocate(this%link_flags%s) if (allocated(this%link_dirs)) deallocate(this%link_dirs) if (allocated(this%link_libs)) deallocate(this%link_libs) if (allocated(this%dependency)) deallocate(this%dependency) - if (allocated(this%dev_dependency)) deallocate(this%dev_dependency) end subroutine destroy From 58dff6c6878797c26a84401b44b1ce43ae132048 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 30 Mar 2023 09:18:21 +0200 Subject: [PATCH 017/304] add stdlib metapackage dependencies --- src/fpm_meta.f90 | 31 +++++++++++++++++++++++++++---- 1 file changed, 27 insertions(+), 4 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 4569f95e5b..3ab635c616 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -18,6 +18,8 @@ module fpm_meta use fpm_compiler use fpm_model use fpm_manifest_dependency, only: dependency_config_t +use fpm_git, only : git_target_branch + implicit none private @@ -54,8 +56,6 @@ module fpm_meta !> Add metapackage dependencies to the model procedure :: resolve - - end type metapackage_t contains @@ -158,8 +158,26 @@ subroutine init_stdlib(this,compiler,error) !> Cleanup call destroy(this) - !> Not implemented yet - call fatal_error(error,'stdlib not supported yet') + !> Stdlib is queried as a dependency from the official repository + this%has_dependencies = .true. + + allocate(this%dependency(2)) + + !> 1) Test-drive + this%dependency(1)%name = "test-drive" + this%dependency(1)%git = git_target_branch("https://github.com/fortran-lang/test-drive","v0.4.0") + if (.not.allocated(this%dependency(1)%git)) then + call fatal_error(error,'cannot initialize test-drive git dependency for stdlib metapackage') + return + end if + + !> 2) stdlib + this%dependency(2)%name = "stdlib" + this%dependency(2)%git = git_target_branch("https://github.com/fortran-lang/stdlib","stdlib-fpm") + if (.not.allocated(this%dependency(2)%git)) then + call fatal_error(error,'cannot initialize git repo dependency for stdlib metapackage') + return + end if end subroutine init_stdlib @@ -188,6 +206,11 @@ subroutine resolve(self,model,error) model%include_dirs = [model%include_dirs,self%link_dirs] end if + ! Add dependencies + if (self%has_dependencies) then + call model%deps%add(self%dependency, error) + endif + end subroutine resolve ! Add named metapackage dependency to the model From 1ee338e2f9f9c82183d0406220de6f629215b7e0 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 30 Mar 2023 09:32:47 +0200 Subject: [PATCH 018/304] compiler flags: refactor into a subroutine --- src/fpm.f90 | 57 ++++++++++++++++++++++++++++++++--------------------- 1 file changed, 35 insertions(+), 22 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 060abd5b38..c21c1a42f7 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -45,7 +45,7 @@ subroutine build_model(model, settings, package, error) integer :: i, j type(package_config_t) :: dependency - character(len=:), allocatable :: manifest, lib_dir, flags, cflags, cxxflags, ldflags + character(len=:), allocatable :: manifest, lib_dir character(len=:), allocatable :: version logical :: has_cpp @@ -60,6 +60,7 @@ subroutine build_model(model, settings, package, error) call new_dependency_tree(model%deps, cache=join_path("build", "cache.toml")) call model%deps%add(package, error) + if (allocated(error)) return ! Update dependencies where needed @@ -76,27 +77,14 @@ subroutine build_model(model, settings, package, error) call new_archiver(model%archiver, settings%archiver, & & echo=settings%verbose, verbose=settings%verbose) - if (settings%flag == '') then - flags = model%compiler%get_default_flags(settings%profile == "release") - else - flags = settings%flag - select case(settings%profile) - case("release", "debug") - flags = flags // model%compiler%get_default_flags(settings%profile == "release") - end select - end if - - cflags = trim(settings%cflag) - cxxflags = trim(settings%cxxflag) - ldflags = trim(settings%ldflag) - if (model%compiler%is_unknown()) then write(*, '(*(a:,1x))') & "", "Unknown compiler", model%compiler%fc, "requested!", & "Defaults for this compiler might be incorrect" end if - model%build_prefix = join_path("build", basename(model%compiler%fc)) + call new_compiler_flags(model,settings) + model%build_prefix = join_path("build", basename(model%compiler%fc)) model%include_tests = settings%build_tests model%enforce_module_names = package%build%module_naming model%module_prefix = package%build%module_prefix @@ -170,18 +158,15 @@ subroutine build_model(model, settings, package, error) end do if (allocated(error)) return - if (has_cpp) call set_cpp_preprocessor_flags(model%compiler%id, flags) - model%fortran_compile_flags = flags - model%c_compile_flags = cflags - model%cxx_compile_flags = cxxflags - model%link_flags = ldflags + ! Add optional flags + if (has_cpp) call set_cpp_preprocessor_flags(model%compiler%id, model%fortran_compile_flags) ! Build and resolve metapackage dependencies if (package%build%openmp) call add_metapackage(model,"openmp",error) if (allocated(error)) return ! Stdlib is available but not implemented yet - if (package%build%stdlib) call fatal_error(error,"stdlib is not implemented yet") + if (package%build%stdlib) call add_metapackage(model,"stdlib",error) if (allocated(error)) return ! Add sources from executable directories @@ -267,6 +252,34 @@ subroutine build_model(model, settings, package, error) end if end subroutine build_model +!> Initialize model compiler flags +subroutine new_compiler_flags(model,settings) + type(fpm_model_t), intent(inout) :: model + type(fpm_build_settings), intent(in) :: settings + + character(len=:), allocatable :: flags, cflags, cxxflags, ldflags + + if (settings%flag == '') then + flags = model%compiler%get_default_flags(settings%profile == "release") + else + flags = settings%flag + select case(settings%profile) + case("release", "debug") + flags = flags // model%compiler%get_default_flags(settings%profile == "release") + end select + end if + + cflags = trim(settings%cflag) + cxxflags = trim(settings%cxxflag) + ldflags = trim(settings%ldflag) + + model%fortran_compile_flags = flags + model%c_compile_flags = cflags + model%cxx_compile_flags = cxxflags + model%link_flags = ldflags + +end subroutine new_compiler_flags + ! Check for duplicate modules subroutine check_modules_for_duplicates(model, duplicates_found) type(fpm_model_t), intent(in) :: model From ebc815657251955c80ba60c33658afed10b33054 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 30 Mar 2023 09:35:58 +0200 Subject: [PATCH 019/304] package dependencies: reorganize code so they're done at the same time --- src/fpm.f90 | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index c21c1a42f7..3e38321f6e 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -58,15 +58,6 @@ subroutine build_model(model, settings, package, error) allocate(model%link_libraries(0)) allocate(model%external_modules(0)) - call new_dependency_tree(model%deps, cache=join_path("build", "cache.toml")) - call model%deps%add(package, error) - - if (allocated(error)) return - - ! Update dependencies where needed - call model%deps%update(error) - if (allocated(error)) return - ! build/ directory should now exist if (.not.exists("build/.gitignore")) then call filewrite(join_path("build", ".gitignore"),["*"]) @@ -89,6 +80,23 @@ subroutine build_model(model, settings, package, error) model%enforce_module_names = package%build%module_naming model%module_prefix = package%build%module_prefix + ! Create dependencies + call new_dependency_tree(model%deps, cache=join_path("build", "cache.toml")) + call model%deps%add(package, error) + if (allocated(error)) return + + ! Build and resolve metapackage dependencies and flags + if (package%build%openmp) call add_metapackage(model,"openmp",error) + if (allocated(error)) return + + ! Stdlib is available but not implemented yet + if (package%build%stdlib) call add_metapackage(model,"stdlib",error) + if (allocated(error)) return + + ! Update dependencies where needed + call model%deps%update(error) + if (allocated(error)) return + allocate(model%packages(model%deps%ndep)) has_cpp = .false. @@ -161,14 +169,6 @@ subroutine build_model(model, settings, package, error) ! Add optional flags if (has_cpp) call set_cpp_preprocessor_flags(model%compiler%id, model%fortran_compile_flags) - ! Build and resolve metapackage dependencies - if (package%build%openmp) call add_metapackage(model,"openmp",error) - if (allocated(error)) return - - ! Stdlib is available but not implemented yet - if (package%build%stdlib) call add_metapackage(model,"stdlib",error) - if (allocated(error)) return - ! Add sources from executable directories if (is_dir('app') .and. package%build%auto_executables) then call add_sources_from_dir(model%packages(1)%sources,'app', FPM_SCOPE_APP, & From 53d4ae7ec352b8d07bb0698374e1c225f0b1612f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 30 Mar 2023 09:39:15 +0200 Subject: [PATCH 020/304] fix: move down .gitignore --- src/fpm.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 3e38321f6e..fbe71f53bc 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -58,11 +58,6 @@ subroutine build_model(model, settings, package, error) allocate(model%link_libraries(0)) allocate(model%external_modules(0)) - ! build/ directory should now exist - if (.not.exists("build/.gitignore")) then - call filewrite(join_path("build", ".gitignore"),["*"]) - end if - call new_compiler(model%compiler, settings%compiler, settings%c_compiler, & & settings%cxx_compiler, echo=settings%verbose, verbose=settings%verbose) call new_archiver(model%archiver, settings%archiver, & @@ -97,6 +92,11 @@ subroutine build_model(model, settings, package, error) call model%deps%update(error) if (allocated(error)) return + ! build/ directory should now exist + if (.not.exists("build/.gitignore")) then + call filewrite(join_path("build", ".gitignore"),["*"]) + end if + allocate(model%packages(model%deps%ndep)) has_cpp = .false. From bdfd25a88bf336f7dc1373f2fadcfcee1cb051f8 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 30 Mar 2023 10:21:41 +0200 Subject: [PATCH 021/304] move all metapackages resolution to `fpm_meta.f90`, cleanup `fpm.f90` --- src/fpm.f90 | 18 +++++----- src/fpm_meta.f90 | 90 +++++++++++++++++++++++++++++++++++++++++++----- 2 files changed, 89 insertions(+), 19 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index fbe71f53bc..a6bffdaba2 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -21,7 +21,7 @@ module fpm resolve_target_linking, build_target_t, build_target_ptr, & FPM_TARGET_EXECUTABLE, FPM_TARGET_ARCHIVE use fpm_manifest, only : get_package_data, package_config_t -use fpm_meta, only : add_metapackage +use fpm_meta, only : resolve_metapackages use fpm_error, only : error_t, fatal_error, fpm_stop use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & @@ -40,7 +40,7 @@ subroutine build_model(model, settings, package, error) ! type(fpm_model_t), intent(out) :: model type(fpm_build_settings), intent(in) :: settings - type(package_config_t), intent(in) :: package + type(package_config_t), intent(inout) :: package type(error_t), allocatable, intent(out) :: error integer :: i, j @@ -75,17 +75,15 @@ subroutine build_model(model, settings, package, error) model%enforce_module_names = package%build%module_naming model%module_prefix = package%build%module_prefix - ! Create dependencies - call new_dependency_tree(model%deps, cache=join_path("build", "cache.toml")) - call model%deps%add(package, error) + ! Resolve meta-dependencies into the package and the model + call resolve_metapackages(model,package,error) if (allocated(error)) return - ! Build and resolve metapackage dependencies and flags - if (package%build%openmp) call add_metapackage(model,"openmp",error) - if (allocated(error)) return + ! Create dependencies + call new_dependency_tree(model%deps, cache=join_path("build", "cache.toml")) - ! Stdlib is available but not implemented yet - if (package%build%stdlib) call add_metapackage(model,"stdlib",error) + ! Build and resolve model dependencies + call model%deps%add(package, error) if (allocated(error)) return ! Update dependencies where needed diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 3ab635c616..e03896800d 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -19,12 +19,13 @@ module fpm_meta use fpm_model use fpm_manifest_dependency, only: dependency_config_t use fpm_git, only : git_target_branch +use fpm_manifest, only: package_config_t implicit none private -public :: add_metapackage +public :: resolve_metapackages !> Type for describing a source file type, public :: metapackage_t @@ -54,10 +55,16 @@ module fpm_meta procedure :: new => init_from_name !> Add metapackage dependencies to the model - procedure :: resolve + procedure, private :: resolve_model + procedure, private :: resolve_package_config + generic :: resolve => resolve_model,resolve_package_config end type metapackage_t +interface resolve_metapackages + module procedure resolve_metapackage_model +end interface resolve_metapackages + contains !> Clean the metapackage structure @@ -182,7 +189,7 @@ subroutine init_stdlib(this,compiler,error) end subroutine init_stdlib ! Resolve metapackage dependencies into the model -subroutine resolve(self,model,error) +subroutine resolve_model(self,model,error) class(metapackage_t), intent(in) :: self type(fpm_model_t), intent(inout) :: model type(error_t), allocatable, intent(out) :: error @@ -206,15 +213,29 @@ subroutine resolve(self,model,error) model%include_dirs = [model%include_dirs,self%link_dirs] end if - ! Add dependencies + ! Dependencies are resolved in the package config + +end subroutine resolve_model + +subroutine resolve_package_config(self,package,error) + class(metapackage_t), intent(in) :: self + type(package_config_t), intent(inout) :: package + type(error_t), allocatable, intent(out) :: error + + ! All metapackage dependencies are added as full dependencies, + ! as upstream projects will not otherwise compile without them if (self%has_dependencies) then - call model%deps%add(self%dependency, error) - endif + if (allocated(package%dependency)) then + package%dependency = [package%dependency,self%dependency] + else + package%dependency = self%dependency + end if + end if -end subroutine resolve +end subroutine resolve_package_config ! Add named metapackage dependency to the model -subroutine add_metapackage(model,name,error) +subroutine add_metapackage_model(model,name,error) type(fpm_model_t), intent(inout) :: model character(*), intent(in) :: name type(error_t), allocatable, intent(out) :: error @@ -229,6 +250,57 @@ subroutine add_metapackage(model,name,error) call meta%resolve(model,error) if (allocated(error)) return -end subroutine add_metapackage +end subroutine add_metapackage_model + +! Add named metapackage dependency to the model +subroutine add_metapackage_config(package,compiler,name,error) + type(package_config_t), intent(inout) :: package + type(compiler_t), intent(in) :: compiler + character(*), intent(in) :: name + type(error_t), allocatable, intent(out) :: error + + type(metapackage_t) :: meta + + !> Init metapackage + call meta%new(name,compiler,error) + if (allocated(error)) return + + !> Add it to the model + call meta%resolve(package,error) + if (allocated(error)) return + +end subroutine add_metapackage_config + +!> Resolve all metapackages into the package config +subroutine resolve_metapackage_model(model,package,error) + type(fpm_model_t), intent(inout) :: model + type(package_config_t), intent(inout) :: package + type(error_t), allocatable, intent(out) :: error + + ! Dependencies are added to the package config, so they're properly resolved + ! into the dependency tree later. + ! Flags are added to the model (whose compiler needs to be already initialized) + if (model%compiler%is_unknown()) then + call fatal_error(error,"compiler not initialized: cannot build metapackages") + return + end if + + ! OpenMP + if (package%build%openmp) then + call add_metapackage_model(model,"openmp",error) + if (allocated(error)) return + call add_metapackage_config(package,model%compiler,"openmp",error) + if (allocated(error)) return + endif + + ! stdlib + if (package%build%stdlib) then + call add_metapackage_model(model,"stdlib",error) + if (allocated(error)) return + call add_metapackage_config(package,model%compiler,"stdlib",error) + if (allocated(error)) return + endif + +end subroutine resolve_metapackage_model end module fpm_meta From 029fee3b440dd94e564cca38c2177617696fa25a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 30 Mar 2023 10:38:42 +0200 Subject: [PATCH 022/304] warn users for simultaneous openMP+stdlib dependencies --- src/fpm_meta.f90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index e03896800d..a817a36cb4 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -20,6 +20,7 @@ module fpm_meta use fpm_manifest_dependency, only: dependency_config_t use fpm_git, only : git_target_branch use fpm_manifest, only: package_config_t +use iso_fortran_env, only: stdout => output_unit implicit none @@ -301,6 +302,11 @@ subroutine resolve_metapackage_model(model,package,error) if (allocated(error)) return endif + ! Stdlib is not 100% thread safe. print a warning to the user + if (package%build%stdlib .and. package%build%openmp) then + write(stdout,'(a)')' both openmp and stdlib requested: some functions may not be thread-safe!' + end if + end subroutine resolve_metapackage_model end module fpm_meta From b504db8cbcf35d0e0e0f1afb82fa63f4c25be0f4 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 30 Mar 2023 11:07:10 +0200 Subject: [PATCH 023/304] add test and CI --- ci/run_tests.sh | 13 +++++++++- example_packages/metapackage_stdlib/README.md | 4 ++++ .../metapackage_stdlib/app/main.f90 | 24 +++++++++++++++++++ example_packages/metapackage_stdlib/fpm.toml | 13 ++++++++++ .../src/metapackage_stdlib.f90 | 10 ++++++++ 5 files changed, 63 insertions(+), 1 deletion(-) create mode 100644 example_packages/metapackage_stdlib/README.md create mode 100644 example_packages/metapackage_stdlib/app/main.f90 create mode 100644 example_packages/metapackage_stdlib/fpm.toml create mode 100644 example_packages/metapackage_stdlib/src/metapackage_stdlib.f90 diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 2f46b0f0de..a3c2c23218 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -195,7 +195,18 @@ popd # Test metapackages pushd metapackage_openmp -"$fpm" build +EXIT_CODE=0 +"$fpm" build || EXIT_CODE=$? +test $EXIT_CODE -eq 0 +EXIT_CODE=0 +"$fpm" run || EXIT_CODE=$? +test $EXIT_CODE -eq 0 +popd + +pushd metapackage_stdlib +EXIT_CODE=0 +"$fpm" build || EXIT_CODE=$? +test $EXIT_CODE -eq 0 EXIT_CODE=0 "$fpm" run || EXIT_CODE=$? test $EXIT_CODE -eq 0 diff --git a/example_packages/metapackage_stdlib/README.md b/example_packages/metapackage_stdlib/README.md new file mode 100644 index 0000000000..11eddc7462 --- /dev/null +++ b/example_packages/metapackage_stdlib/README.md @@ -0,0 +1,4 @@ +# test_stdlib +This test program generates a real [1,2,3,4,5] array using stdlib. +stdlib math and kinds modules are invoked; so this program cannot be built if stdlib is not +properly built and linked. stdlib tests are not run in this program. diff --git a/example_packages/metapackage_stdlib/app/main.f90 b/example_packages/metapackage_stdlib/app/main.f90 new file mode 100644 index 0000000000..30630e90a6 --- /dev/null +++ b/example_packages/metapackage_stdlib/app/main.f90 @@ -0,0 +1,24 @@ +! fortran-lang stdlib test case +! This test program will only run if stdlib is properly built and linked to this project. +program test_stdlib_metapackage + + ! These USEs would not be possible if stdlib is not found + use stdlib_kinds, only: int32, int64, dp, sp + use stdlib_math + implicit none + + real(dp), allocatable :: indices(:) + + indices = linspace(1.0_dp,5.0_dp,5) + + if (.not.allocated(indices)) then + stop 1 + elseif (size(indices)/=5) then + stop 2 + elseif (any(nint(indices)/=[1,2,3,4,5])) then + stop 3 + else + stop 0 + endif + +end program test_stdlib_metapackage diff --git a/example_packages/metapackage_stdlib/fpm.toml b/example_packages/metapackage_stdlib/fpm.toml new file mode 100644 index 0000000000..50faf70022 --- /dev/null +++ b/example_packages/metapackage_stdlib/fpm.toml @@ -0,0 +1,13 @@ +name = "test_stdlib" +version = "0.1.0" +license = "license" +author = "Federico Perini" +maintainer = "federico.perini@hello.world" +copyright = "Copyright 2023, Federico Perini and the fpm maintainers" +[build] +auto-executables = true +auto-tests = true +auto-examples = true +stdlib = true +[install] +library = false diff --git a/example_packages/metapackage_stdlib/src/metapackage_stdlib.f90 b/example_packages/metapackage_stdlib/src/metapackage_stdlib.f90 new file mode 100644 index 0000000000..4f041d6d7d --- /dev/null +++ b/example_packages/metapackage_stdlib/src/metapackage_stdlib.f90 @@ -0,0 +1,10 @@ +module metapackage_stdlib + implicit none + private + + public :: say_hello +contains + subroutine say_hello + print *, "Hello, metapackage_stdlib!" + end subroutine say_hello +end module metapackage_stdlib From c8a7ce8b5ec4f71c5cc95fc68743a52bc264fb22 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 30 Mar 2023 14:17:53 +0200 Subject: [PATCH 024/304] restore CI --- .github/workflows/CI.yml | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 182891dd16..297fe11514 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -51,6 +51,17 @@ jobs: ln -s /usr/local/bin/gfortran-${GCC_V} /usr/local/bin/gfortran which gfortran-${GCC_V} which gfortran + # Backport gfortran shared libraries to version 9 folder. This is necessary because all macOS releases of fpm + # have these paths hardcoded in the executable (no PIC?). As the gcc ABIs have not changed from 9 to 10, we + # can just create symbolic links for now. This can be removed when an updated fpm release is built with gcc-10 + mkdir /usr/local/opt/gcc@9 + mkdir /usr/local/opt/gcc@9/lib + mkdir /usr/local/opt/gcc@9/lib/gcc + mkdir /usr/local/opt/gcc@9/lib/gcc/9 + mkdir /usr/local/lib/gcc/9 + ln -fs /usr/local/opt/gcc@${GCC_V}/lib/gcc/${GCC_V}/libquadmath.0.dylib /usr/local/opt/gcc@9/lib/gcc/9/libquadmath.0.dylib + ln -fs /usr/local/opt/gcc@${GCC_V}/lib/gcc/${GCC_V}/libgfortran.5.dylib /usr/local/opt/gcc@9/lib/gcc/9/libgfortran.5.dylib + ln -fs /usr/local/lib/gcc/${GCC_V}/libgcc_s.1.dylib /usr/local/lib/gcc/9/libgcc_s.1.dylib - name: Install GFortran Linux if: contains(matrix.os, 'ubuntu') From db0e4709384b6cafb1324948683178558f71a4ae Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 3 Apr 2023 15:35:10 +0200 Subject: [PATCH 025/304] create metapackages config --- example_packages/metapackage_openmp/fpm.toml | 4 + example_packages/metapackage_stdlib/fpm.toml | 4 + src/fpm/manifest/build.f90 | 27 +----- src/fpm/manifest/meta.f90 | 99 ++++++++++++++++++++ src/fpm/manifest/package.f90 | 18 +++- src/fpm_meta.f90 | 6 +- 6 files changed, 126 insertions(+), 32 deletions(-) create mode 100644 src/fpm/manifest/meta.f90 diff --git a/example_packages/metapackage_openmp/fpm.toml b/example_packages/metapackage_openmp/fpm.toml index 92105e5d8c..051a88f2d2 100644 --- a/example_packages/metapackage_openmp/fpm.toml +++ b/example_packages/metapackage_openmp/fpm.toml @@ -4,10 +4,14 @@ license = "license" author = "Federico Perini" maintainer = "federico.perini@hello.world" copyright = "Copyright 2023, Federico Perini and the fpm maintainers" + [build] auto-executables = true auto-tests = true auto-examples = true + +[metapackages] openmp = true + [install] library = false diff --git a/example_packages/metapackage_stdlib/fpm.toml b/example_packages/metapackage_stdlib/fpm.toml index 50faf70022..8e11f13458 100644 --- a/example_packages/metapackage_stdlib/fpm.toml +++ b/example_packages/metapackage_stdlib/fpm.toml @@ -4,10 +4,14 @@ license = "license" author = "Federico Perini" maintainer = "federico.perini@hello.world" copyright = "Copyright 2023, Federico Perini and the fpm maintainers" + [build] auto-executables = true auto-tests = true auto-examples = true + +[metapackages] stdlib = true + [install] library = false diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index 3d505b93a2..fb7fae4c42 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -34,15 +34,7 @@ module fpm_manifest_build logical :: module_naming = .false. type(string_t) :: module_prefix - !> Metapackages - !> @note when several metapackages are supported, this will need be generalized - - !> Request OpenMP support - logical :: openmp = .false. - - !> Request stdlib support - logical :: stdlib = .false. - + !> Libraries to link against !> Libraries to link against type(string_t), allocatable :: link(:) @@ -128,19 +120,6 @@ subroutine new_build_config(self, table, error) end if - !> Metapackages: read all flags - call get_value(table, "openmp", self%openmp, .false., stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error,"Error while reading value for 'openmp' in fpm.toml, expecting logical") - return - end if - - call get_value(table, "stdlib", self%stdlib, .false., stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error,"Error while reading value for 'stdlib' in fpm.toml, expecting logical") - return - end if - call get_list(table, "link", self%link, error) if (allocated(error)) return @@ -175,10 +154,6 @@ subroutine check(table, error) case ("module-naming") continue - !> Supported metapackages - case ("openmp","stdlib") - continue - case default call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in [build]") exit diff --git a/src/fpm/manifest/meta.f90 b/src/fpm/manifest/meta.f90 new file mode 100644 index 0000000000..1d7d8c5ac4 --- /dev/null +++ b/src/fpm/manifest/meta.f90 @@ -0,0 +1,99 @@ +!> Implementation of the metapackage configuration data. +!> +!> A metapackage table can currently have the following fields +!> +!>```toml +!>[metapackages] +!>fpm = "0.1.0" +!>openmp = bool +!>stdlib = bool +!>``` +module fpm_manifest_metapackages + use fpm_error, only: error_t, fatal_error, syntax_error + use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + implicit none + private + + public :: metapackage_config_t, new_meta_config + + !> Configuration data for metapackages + type :: metapackage_config_t + + !> Request OpenMP support + logical :: openmp = .false. + + !> Request stdlib support + logical :: stdlib = .false. + + + end type metapackage_config_t + + +contains + + + !> Construct a new build configuration from a TOML data structure + subroutine new_meta_config(self, table, error) + + !> Instance of the build configuration + type(metapackage_config_t), intent(out) :: self + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: stat + + call check(table, error) + if (allocated(error)) return + + call get_value(table, "openmp", self%openmp, .false., stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'openmp' in fpm.toml, expecting logical") + return + end if + + call get_value(table, "stdlib", self%stdlib, .false., stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'stdlib' in fpm.toml, expecting logical") + return + end if + + end subroutine new_meta_config + + !> Check local schema for allowed entries + subroutine check(table, error) + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_key), allocatable :: list(:) + integer :: ikey + + call table%get_keys(list) + + ! table can be empty + if (size(list) < 1) return + + do ikey = 1, size(list) + select case(list(ikey)%key) + + !> Supported metapackages + case ("openmp","stdlib") + continue + + case default + call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in [metapackages]") + exit + + end select + end do + + end subroutine check + +end module fpm_manifest_metapackages diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index de124a0b3e..32c6fb3fda 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -42,6 +42,7 @@ module fpm_manifest_package use fpm_manifest_install, only: install_config_t, new_install_config use fpm_manifest_test, only : test_config_t, new_test use fpm_mainfest_preprocess, only : preprocess_config_t, new_preprocessors + use fpm_manifest_metapackages, only: metapackage_config_t, new_meta_config use fpm_filesystem, only : exists, getline, join_path use fpm_error, only : error_t, fatal_error, syntax_error, bad_name_error use fpm_toml, only : toml_table, toml_array, toml_key, toml_stat, get_value, & @@ -72,6 +73,9 @@ module fpm_manifest_package !> Build configuration data type(build_config_t) :: build + !> Metapackage data + type(metapackage_config_t) :: meta + !> Installation configuration data type(install_config_t) :: install @@ -165,6 +169,14 @@ subroutine new_package(self, table, root, error) call new_build_config(self%build, child, error) if (allocated(error)) return + call get_value(table, "metapackages", child, requested=.true., stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error, "Type mismatch for metapackages entry, must be a table") + return + end if + call new_meta_config(self%meta, child, error) + if (allocated(error)) return + call get_value(table, "install", child, requested=.true., stat=stat) if (stat /= toml_stat%success) then call fatal_error(error, "Type mismatch for install entry, must be a table") @@ -214,7 +226,7 @@ subroutine new_package(self, table, root, error) call new_library(self%library, child, error) if (allocated(error)) return end if - + call get_value(table, "profiles", child, requested=.false.) if (associated(child)) then call new_profiles(self%profiles, child, error) @@ -328,7 +340,7 @@ subroutine check(table, error) case("version", "license", "author", "maintainer", "copyright", & & "description", "keywords", "categories", "homepage", "build", & & "dependencies", "dev-dependencies", "profiles", "test", "executable", & - & "example", "library", "install", "extra", "preprocess") + & "example", "library", "install", "extra", "preprocess", "metapackages") continue end select @@ -424,7 +436,7 @@ subroutine info(self, unit, verbosity) call self%dev_dependency(ii)%info(unit, pr - 1) end do end if - + if (allocated(self%profiles)) then if (size(self%profiles) > 1 .or. pr > 2) then write(unit, fmti) "- profiles", size(self%profiles) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index a817a36cb4..879d6ac98a 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -287,7 +287,7 @@ subroutine resolve_metapackage_model(model,package,error) end if ! OpenMP - if (package%build%openmp) then + if (package%meta%openmp) then call add_metapackage_model(model,"openmp",error) if (allocated(error)) return call add_metapackage_config(package,model%compiler,"openmp",error) @@ -295,7 +295,7 @@ subroutine resolve_metapackage_model(model,package,error) endif ! stdlib - if (package%build%stdlib) then + if (package%meta%stdlib) then call add_metapackage_model(model,"stdlib",error) if (allocated(error)) return call add_metapackage_config(package,model%compiler,"stdlib",error) @@ -303,7 +303,7 @@ subroutine resolve_metapackage_model(model,package,error) endif ! Stdlib is not 100% thread safe. print a warning to the user - if (package%build%stdlib .and. package%build%openmp) then + if (package%meta%stdlib .and. package%meta%openmp) then write(stdout,'(a)')' both openmp and stdlib requested: some functions may not be thread-safe!' end if From c09f16b6ce3e5a067beab86e3a507eaee1e1ef75 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 3 Apr 2023 15:50:50 +0200 Subject: [PATCH 026/304] introduce MPI keyword --- src/fpm/manifest/meta.f90 | 11 ++++++++++- src/fpm_meta.f90 | 10 +++++++++- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/src/fpm/manifest/meta.f90 b/src/fpm/manifest/meta.f90 index 1d7d8c5ac4..e3f21fd6ea 100644 --- a/src/fpm/manifest/meta.f90 +++ b/src/fpm/manifest/meta.f90 @@ -19,6 +19,9 @@ module fpm_manifest_metapackages !> Configuration data for metapackages type :: metapackage_config_t + !> Request MPI support + logical :: mpi = .false. + !> Request OpenMP support logical :: openmp = .false. @@ -61,6 +64,12 @@ subroutine new_meta_config(self, table, error) return end if + call get_value(table, "mpi", self%mpi, .false., stat=stat) + if (stat /= toml_stat%success) then + call fatal_error(error,"Error while reading value for 'mpi' in fpm.toml, expecting logical") + return + end if + end subroutine new_meta_config !> Check local schema for allowed entries @@ -84,7 +93,7 @@ subroutine check(table, error) select case(list(ikey)%key) !> Supported metapackages - case ("openmp","stdlib") + case ("openmp","stdlib","mpi") continue case default diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 879d6ac98a..f97484a2d7 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -98,7 +98,7 @@ subroutine init_from_name(this,name,compiler,error) case("openmp"); call init_openmp(this,compiler,error) case("stdlib"); call init_stdlib(this,compiler,error) case default - call syntax_error(error, "Metapackage "//name//" is not supported in [build]") + call syntax_error(error, "Package "//name//" is not supported in [metapackages]") return end select @@ -307,6 +307,14 @@ subroutine resolve_metapackage_model(model,package,error) write(stdout,'(a)')' both openmp and stdlib requested: some functions may not be thread-safe!' end if + ! MPI + if (package%meta%mpi) then + call add_metapackage_model(model,"mpi",error) + if (allocated(error)) return + call add_metapackage_config(package,model%compiler,"mpi",error) + if (allocated(error)) return + endif + end subroutine resolve_metapackage_model end module fpm_meta From ce02cbea2dc84474ec64d6218d1fa383c5f126ab Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 3 Apr 2023 15:52:38 +0200 Subject: [PATCH 027/304] write MPI Fortran test program --- example_packages/metapackage_mpi/README.md | 7 +++++ example_packages/metapackage_mpi/app/main.f90 | 30 +++++++++++++++++++ example_packages/metapackage_mpi/fpm.toml | 15 ++++++++++ 3 files changed, 52 insertions(+) create mode 100644 example_packages/metapackage_mpi/README.md create mode 100644 example_packages/metapackage_mpi/app/main.f90 create mode 100644 example_packages/metapackage_mpi/fpm.toml diff --git a/example_packages/metapackage_mpi/README.md b/example_packages/metapackage_mpi/README.md new file mode 100644 index 0000000000..e1ea0c2194 --- /dev/null +++ b/example_packages/metapackage_mpi/README.md @@ -0,0 +1,7 @@ +# test_mpi +This test program prints the running thread ID using MPI. +PLEASE NOTE: +- Test app uses 'mpif.h' and not 'use mpi' or 'use mpi_f08' because the latter are compiler-dependent, + and the MPI implementation on the local machine may not offer an implementation for them with the same + compiler that fpm is using. +- Using mpif.h will be the most backward compatible and platform agnostic diff --git a/example_packages/metapackage_mpi/app/main.f90 b/example_packages/metapackage_mpi/app/main.f90 new file mode 100644 index 0000000000..f3c3bde606 --- /dev/null +++ b/example_packages/metapackage_mpi/app/main.f90 @@ -0,0 +1,30 @@ +program with_mpi + + include 'mpif.h' + + integer, parameter :: INIT_ERROR = 1 + integer, parameter :: RANK_ERROR = 2 + + integer :: ierror,ncpus,cpuid + + ! Initialize MPI argument + call MPI_INIT(ierror); + if (ierror/=0) stop INIT_ERROR + + ! Get number of processes and current rank + call MPI_Comm_size(MPI_COMM_WORLD, ncpus, ierror) + if (ierror/=0) stop RANK_ERROR + + call MPI_Comm_rank(MPI_COMM_WORLD, cpuid, ierror) + if (ierror/=0) stop RANK_ERROR + + print "('Hello, mpi world from rank ',i0,' of ',i0,'!')", cpuid+1,ncpu + + ! Finalize MPI environment. + call MPI_FINALIZE(ierror) + if (ierror/=0) stop INIT_ERROR + + stop 0 + +end program with_mpi + diff --git a/example_packages/metapackage_mpi/fpm.toml b/example_packages/metapackage_mpi/fpm.toml new file mode 100644 index 0000000000..398aa0ee35 --- /dev/null +++ b/example_packages/metapackage_mpi/fpm.toml @@ -0,0 +1,15 @@ +name = "test_mpi" +version = "0.1.0" +license = "license" +author = "Federico Perini" +maintainer = "federico.perini@hello.world" +copyright = "Copyright 2023, Federico Perini and the fpm maintainers" + +[build] +auto-executables = true + +[metapackages] +mpi = true + +[install] +library = false From de84fe880f2d2cd6851379211be70d5ed4d14162 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 3 Apr 2023 15:57:15 +0200 Subject: [PATCH 028/304] C MPI test program --- example_packages/metapackage_mpi_c/README.md | 7 ++++++ example_packages/metapackage_mpi_c/app/main.c | 25 +++++++++++++++++++ example_packages/metapackage_mpi_c/fpm.toml | 16 ++++++++++++ 3 files changed, 48 insertions(+) create mode 100644 example_packages/metapackage_mpi_c/README.md create mode 100644 example_packages/metapackage_mpi_c/app/main.c create mode 100644 example_packages/metapackage_mpi_c/fpm.toml diff --git a/example_packages/metapackage_mpi_c/README.md b/example_packages/metapackage_mpi_c/README.md new file mode 100644 index 0000000000..e1ea0c2194 --- /dev/null +++ b/example_packages/metapackage_mpi_c/README.md @@ -0,0 +1,7 @@ +# test_mpi +This test program prints the running thread ID using MPI. +PLEASE NOTE: +- Test app uses 'mpif.h' and not 'use mpi' or 'use mpi_f08' because the latter are compiler-dependent, + and the MPI implementation on the local machine may not offer an implementation for them with the same + compiler that fpm is using. +- Using mpif.h will be the most backward compatible and platform agnostic diff --git a/example_packages/metapackage_mpi_c/app/main.c b/example_packages/metapackage_mpi_c/app/main.c new file mode 100644 index 0000000000..2bc56c4f0c --- /dev/null +++ b/example_packages/metapackage_mpi_c/app/main.c @@ -0,0 +1,25 @@ +// Test MPI linking from a C main program +#include +#include + +int main(int argc, char** argv) +{ + + int ierror,ncpus,cpuid; + + // Initialize MPI argument + MPI_Init(&argc, &argv); + + // Get number of processes and current rank + MPI_Comm_size(MPI_COMM_WORLD, &ncpus); + + // Get Rank of the current process + MPI_Comm_rank(MPI_COMM_WORLD, &cpuid); + + printf("Hello, MPI C World from rank %d of %d! \n",cpuid+1,ncpus); + + // Finalize MPI environment. + MPI_Finalize(); + return 0; +} + diff --git a/example_packages/metapackage_mpi_c/fpm.toml b/example_packages/metapackage_mpi_c/fpm.toml new file mode 100644 index 0000000000..d5e18bac92 --- /dev/null +++ b/example_packages/metapackage_mpi_c/fpm.toml @@ -0,0 +1,16 @@ +name = "test_mpi_c" +version = "0.1.0" +license = "license" +author = "Federico Perini" +maintainer = "federico.perini@hello.world" +copyright = "Copyright 2023, Federico Perini and the fpm maintainers" + +[[executable]] +name = "test-mpi-c-main" +main = "main.c" + +[metapackages] +mpi = true + +[install] +library = false From 29be62f38cc28c55d8ff73823c93f2d9fce8e657 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 3 Apr 2023 16:29:38 +0200 Subject: [PATCH 029/304] add C++ test program; cleanup --- example_packages/metapackage_mpi_c/README.md | 5 --- example_packages/metapackage_mpi_c/app/main.c | 15 ++++++-- .../metapackage_mpi_cpp/README.md | 2 ++ .../metapackage_mpi_cpp/app/main.cpp | 36 +++++++++++++++++++ example_packages/metapackage_mpi_cpp/fpm.toml | 16 +++++++++ 5 files changed, 66 insertions(+), 8 deletions(-) create mode 100644 example_packages/metapackage_mpi_cpp/README.md create mode 100644 example_packages/metapackage_mpi_cpp/app/main.cpp create mode 100644 example_packages/metapackage_mpi_cpp/fpm.toml diff --git a/example_packages/metapackage_mpi_c/README.md b/example_packages/metapackage_mpi_c/README.md index e1ea0c2194..6ec9d07215 100644 --- a/example_packages/metapackage_mpi_c/README.md +++ b/example_packages/metapackage_mpi_c/README.md @@ -1,7 +1,2 @@ # test_mpi This test program prints the running thread ID using MPI. -PLEASE NOTE: -- Test app uses 'mpif.h' and not 'use mpi' or 'use mpi_f08' because the latter are compiler-dependent, - and the MPI implementation on the local machine may not offer an implementation for them with the same - compiler that fpm is using. -- Using mpif.h will be the most backward compatible and platform agnostic diff --git a/example_packages/metapackage_mpi_c/app/main.c b/example_packages/metapackage_mpi_c/app/main.c index 2bc56c4f0c..ab20ac1d16 100644 --- a/example_packages/metapackage_mpi_c/app/main.c +++ b/example_packages/metapackage_mpi_c/app/main.c @@ -8,7 +8,11 @@ int main(int argc, char** argv) int ierror,ncpus,cpuid; // Initialize MPI argument - MPI_Init(&argc, &argv); + ierror = MPI_Init(&argc, &argv); + if (ierror) { + printf("MPI_Init failed with error %d \n",ierror); + return 1; + } // Get number of processes and current rank MPI_Comm_size(MPI_COMM_WORLD, &ncpus); @@ -19,7 +23,12 @@ int main(int argc, char** argv) printf("Hello, MPI C World from rank %d of %d! \n",cpuid+1,ncpus); // Finalize MPI environment. - MPI_Finalize(); - return 0; + ierror = MPI_Finalize(); + if (ierror) { + printf("MPI_Finalize failed with error %d \n",ierror); + return 1; + } else { + return 0; + } } diff --git a/example_packages/metapackage_mpi_cpp/README.md b/example_packages/metapackage_mpi_cpp/README.md new file mode 100644 index 0000000000..6ec9d07215 --- /dev/null +++ b/example_packages/metapackage_mpi_cpp/README.md @@ -0,0 +1,2 @@ +# test_mpi +This test program prints the running thread ID using MPI. diff --git a/example_packages/metapackage_mpi_cpp/app/main.cpp b/example_packages/metapackage_mpi_cpp/app/main.cpp new file mode 100644 index 0000000000..8203285a9e --- /dev/null +++ b/example_packages/metapackage_mpi_cpp/app/main.cpp @@ -0,0 +1,36 @@ +// Test MPI linking from a C main program +#include +#include + +using namespace std; + +int main(int argc, char** argv) +{ + + int ierror,ncpus,cpuid; + + // Initialize MPI argument + ierror = MPI_Init(&argc, &argv); + if (ierror) { + cout << "MPI_Init failed with error " << ierror << endl; + return 1; + } + + // Get number of processes and current rank + MPI_Comm_size(MPI_COMM_WORLD, &ncpus); + + // Get Rank of the current process + MPI_Comm_rank(MPI_COMM_WORLD, &cpuid); + + cout << "Hello, MPI C++ World from rank " << cpuid << " of " << ncpus << "!" << endl; + + // Finalize MPI environment. + ierror = MPI_Finalize(); + if (ierror) { + cout << "MPI_Finalize failed with error " << ierror << endl; + return 1; + } else { + return 0; + } +} + diff --git a/example_packages/metapackage_mpi_cpp/fpm.toml b/example_packages/metapackage_mpi_cpp/fpm.toml new file mode 100644 index 0000000000..01216ea5c6 --- /dev/null +++ b/example_packages/metapackage_mpi_cpp/fpm.toml @@ -0,0 +1,16 @@ +name = "test_mpi_cpp" +version = "0.1.0" +license = "license" +author = "Federico Perini" +maintainer = "federico.perini@hello.world" +copyright = "Copyright 2023, Federico Perini and the fpm maintainers" + +[[executable]] +name = "test-mpi-c++" +main = "main.cpp" + +[metapackages] +mpi = true + +[install] +library = false From a77504b6254de0dc9ed1770fcdb6fdeb0b2ff45f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 3 Apr 2023 16:30:26 +0200 Subject: [PATCH 030/304] add MPI option; inactive --- src/fpm_meta.f90 | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index f97484a2d7..438ea3410b 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -97,6 +97,7 @@ subroutine init_from_name(this,name,compiler,error) select case(name) case("openmp"); call init_openmp(this,compiler,error) case("stdlib"); call init_stdlib(this,compiler,error) + case("mpi"); call init_mpi (this,compiler,error) case default call syntax_error(error, "Package "//name//" is not supported in [metapackages]") return @@ -317,4 +318,18 @@ subroutine resolve_metapackage_model(model,package,error) end subroutine resolve_metapackage_model +!> Initialize MPI metapackage for the current system +subroutine init_mpi(this,compiler,error) + class(metapackage_t), intent(inout) :: this + type(compiler_t), intent(in) :: compiler + type(error_t), allocatable, intent(out) :: error + + !> Cleanup + call destroy(this) + + !> Stop for now + call fatal_error(error,"MPI dependency is recognized but not implemented yet") + +end subroutine init_mpi + end module fpm_meta From 6049c6472061434fea79a9f07feeeafa0a18d7d6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 3 Apr 2023 16:30:58 +0200 Subject: [PATCH 031/304] fix exe name --- example_packages/metapackage_mpi_cpp/fpm.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/example_packages/metapackage_mpi_cpp/fpm.toml b/example_packages/metapackage_mpi_cpp/fpm.toml index 01216ea5c6..da21a5d8a2 100644 --- a/example_packages/metapackage_mpi_cpp/fpm.toml +++ b/example_packages/metapackage_mpi_cpp/fpm.toml @@ -6,7 +6,7 @@ maintainer = "federico.perini@hello.world" copyright = "Copyright 2023, Federico Perini and the fpm maintainers" [[executable]] -name = "test-mpi-c++" +name = "test-mpi-cpp" main = "main.cpp" [metapackages] From 39cdeeb39bce73fbda12912ad0be04af5f8c8ec8 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 3 Apr 2023 18:00:50 +0200 Subject: [PATCH 032/304] attempt several MPI wrappers and filter out the invalid ones --- src/fpm/manifest/meta.f90 | 1 + src/fpm_meta.f90 | 125 +++++++++++++++++++++++++++++++++++++- 2 files changed, 124 insertions(+), 2 deletions(-) diff --git a/src/fpm/manifest/meta.f90 b/src/fpm/manifest/meta.f90 index e3f21fd6ea..ebd38c6559 100644 --- a/src/fpm/manifest/meta.f90 +++ b/src/fpm/manifest/meta.f90 @@ -11,6 +11,7 @@ module fpm_manifest_metapackages use fpm_error, only: error_t, fatal_error, syntax_error use fpm_toml, only : toml_table, toml_key, toml_stat, get_value + use fpm_environment implicit none private diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 438ea3410b..5b0ecceab9 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -20,6 +20,8 @@ module fpm_meta use fpm_manifest_dependency, only: dependency_config_t use fpm_git, only : git_target_branch use fpm_manifest, only: package_config_t +use fpm_environment, only: get_env,os_is_unix +use fpm_filesystem, only: run use iso_fortran_env, only: stdout => output_unit implicit none @@ -324,12 +326,131 @@ subroutine init_mpi(this,compiler,error) type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error + type(string_t), allocatable :: c_wrappers(:),cpp_wrappers(:),fort_wrappers(:) + !> Cleanup call destroy(this) - !> Stop for now - call fatal_error(error,"MPI dependency is recognized but not implemented yet") + !> Get all candidate MPI wrappers + call mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) + + print "('MPI wrapper founds: fortran=',i0,' c=',i0,' c++=',i0)", & + size(fort_wrappers),size(c_wrappers),size(cpp_wrappers) + + if (size(fort_wrappers)*size(c_wrappers)*size(cpp_wrappers)<=0) then + call fatal_error(error,"cannot find MPI wrappers for "//compiler%name()//" compiler") + return + end if + + call fatal_error(error,"MPI is being implemented, but not available yet") + end subroutine init_mpi +!> Return several mpi wrappers, and return +subroutine mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) + type(compiler_t), intent(in) :: compiler + type(string_t), allocatable, intent(out) :: c_wrappers(:),cpp_wrappers(:),fort_wrappers(:) + + ! Attempt gathering MPI wrapper names from the environment variables + c_wrappers = [string_t(get_env('MPICC' ,'mpicc'))] + cpp_wrappers = [string_t(get_env('MPICXX','mpic++'))] + fort_wrappers = [string_t(get_env('MPIFC' ,'mpifc' )),& + string_t(get_env('MPIf90','mpif90')),& + string_t(get_env('MPIf77','mpif77'))] + + if (get_os_type()==OS_WINDOWS) then + c_wrappers = [c_wrappers,string_t('mpicc.bat')] + cpp_wrappers = [cpp_wrappers,string_t('mpicxx.bat')] + fort_wrappers = [fort_wrappers,string_t('mpifc.bat')] + endif + + ! Add compiler-specific wrappers + compiler_specific: select case (compiler%id) + case (id_gcc,id_f95) + + c_wrappers = [c_wrappers,string_t('mpigcc'),string_t('mpgcc')] + cpp_wrappers = [cpp_wrappers,string_t('mpig++'),string_t('mpg++')] + fort_wrappers = [fort_wrappers,string_t('mpigfortran'),string_t('mpgfortran'),& + string_t('mpig77'),string_t('mpg77')] + + case (id_intel_classic_windows,id_intel_llvm_windows,& + id_intel_classic_nix,id_intel_classic_mac,id_intel_llvm_nix,id_intel_llvm_unknown) + + c_wrappers = [c_wrappers,string_t(get_env('I_MPI_CC','mpiicc')),string_t('mpicl.bat')] + cpp_wrappers = [cpp_wrappers,string_t(get_env('I_MPI_CXX','mpiicpc')),string_t('mpicl.bat')] + fort_wrappers = [fort_wrappers,string_t(get_env('I_MPI_F90','mpiifort')),string_t('mpif77'),& + string_t('mpif90')] + + case (id_pgi,id_nvhpc) + + c_wrappers = [c_wrappers,string_t('mpipgicc'),string_t('mpgcc')] + cpp_wrappers = [cpp_wrappers,string_t('mpipgic++')] + fort_wrappers = [fort_wrappers,string_t('mpipgifort'),string_t('mpipgf90')] + + case (id_cray) + + c_wrappers = [c_wrappers,string_t('cc')] + cpp_wrappers = [cpp_wrappers,string_t('CC')] + fort_wrappers = [fort_wrappers,string_t('ftn')] + + end select compiler_specific + + call assert_mpi_wrappers(fort_wrappers) + call assert_mpi_wrappers(c_wrappers) + call assert_mpi_wrappers(cpp_wrappers) + +end subroutine mpi_wrappers + +!> Filter out invalid/unavailable mpi wrappers +subroutine assert_mpi_wrappers(wrappers,verbose) + type(string_t), allocatable, intent(inout) :: wrappers(:) + logical, optional, intent(in) :: verbose + + integer :: i + logical, allocatable :: works(:) + + allocate(works(size(wrappers))) + + do i=1,size(wrappers) + works(i) = is_mpi_wrapper(wrappers(i),verbose) + end do + + ! Filter out non-working wrappers + wrappers = pack(wrappers,works) + +end subroutine assert_mpi_wrappers + +!> Test if an MPI wrapper works +logical function is_mpi_wrapper(wrapper,verbose) + type(string_t), intent(in) :: wrapper + logical, intent(in), optional :: verbose + + logical :: echo_local + character(:), allocatable :: redirect_str + integer :: stat,cmdstat + + if(present(verbose))then + echo_local=verbose + else + echo_local=.true. + end if + + ! No redirection and non-verbose output + if (os_is_unix()) then + redirect_str = " >/dev/null 2>&1" + else + redirect_str = " >NUL 2>&1" + end if + + if(echo_local) print *, '+ ', wrapper%s + + ! Test command + call execute_command_line(wrapper%s//redirect_str, exitstat=stat,cmdstat=cmdstat) + + ! Did this command work? + is_mpi_wrapper = cmdstat==0 + +end function is_mpi_wrapper + end module fpm_meta From 0fd030d7a09bb2a8ebd0515a09f2a29b58a583ac Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Apr 2023 17:45:34 +0200 Subject: [PATCH 033/304] remove [metapackages]; move meta to [dependencies] --- src/fpm/manifest/dependency.f90 | 36 +++++++++++++++++++++++++++++---- src/fpm/manifest/meta.f90 | 35 +++++++++----------------------- src/fpm/manifest/package.f90 | 14 +++---------- 3 files changed, 45 insertions(+), 40 deletions(-) diff --git a/src/fpm/manifest/dependency.f90 b/src/fpm/manifest/dependency.f90 index cf3c1a31d2..0e6e3e3d93 100644 --- a/src/fpm/manifest/dependency.f90 +++ b/src/fpm/manifest/dependency.f90 @@ -29,6 +29,7 @@ module fpm_manifest_dependency use fpm_toml, only : toml_table, toml_key, toml_stat, get_value use fpm_filesystem, only: windows_path use fpm_environment, only: get_os_type, OS_WINDOWS + use fpm_manifest_metapackages, only: metapackage_config_t, is_meta_package, new_meta_config implicit none private @@ -192,11 +193,14 @@ end subroutine check !> Construct new dependency array from a TOML data structure - subroutine new_dependencies(deps, table, root, error) + subroutine new_dependencies(deps, table, root, meta, error) !> Instance of the dependency configuration type(dependency_config_t), allocatable, intent(out) :: deps(:) + !> (optional) metapackages + type(metapackage_config_t), optional, intent(out) :: meta + !> Instance of the TOML data structure type(toml_table), intent(inout) :: table @@ -208,20 +212,44 @@ subroutine new_dependencies(deps, table, root, error) type(toml_table), pointer :: node type(toml_key), allocatable :: list(:) - integer :: idep, stat + logical, allocatable :: non_meta(:) + integer :: idep, stat, ndep call table%get_keys(list) ! An empty table is okay if (size(list) < 1) return - allocate(deps(size(list))) + !> If requesting metapackages, do not stop on meta keywords + if (present(meta)) then + ndep = 0 + do idep = 1, size(list) + if (is_meta_package(list(idep)%key)) cycle + ndep = ndep+1 + end do + + !> Return metapackages config from this node + call new_meta_config(meta, table, error) + if (allocated(error)) return + + else + ndep = size(list) + end if + + allocate(deps(ndep)) + ndep = 0 do idep = 1, size(list) + + ! Skip meta packages + if (present(meta) .and. is_meta_package(list(idep)%key)) cycle + + ndep = ndep+1 + call get_value(table, list(idep)%key, node, stat=stat) if (stat /= toml_stat%success) then call syntax_error(error, "Dependency "//list(idep)%key//" must be a table entry") exit end if - call new_dependency(deps(idep), node, root, error) + call new_dependency(deps(ndep), node, root, error) if (allocated(error)) exit end do diff --git a/src/fpm/manifest/meta.f90 b/src/fpm/manifest/meta.f90 index ebd38c6559..5a72c96db8 100644 --- a/src/fpm/manifest/meta.f90 +++ b/src/fpm/manifest/meta.f90 @@ -15,7 +15,7 @@ module fpm_manifest_metapackages implicit none private - public :: metapackage_config_t, new_meta_config + public :: metapackage_config_t, new_meta_config, is_meta_package !> Configuration data for metapackages type :: metapackage_config_t @@ -35,7 +35,6 @@ module fpm_manifest_metapackages contains - !> Construct a new build configuration from a TOML data structure subroutine new_meta_config(self, table, error) @@ -50,8 +49,8 @@ subroutine new_meta_config(self, table, error) integer :: stat - call check(table, error) - if (allocated(error)) return + !> The toml table is not checked here because it already passed + !> the "new_dependencies" check call get_value(table, "openmp", self%openmp, .false., stat=stat) if (stat /= toml_stat%success) then @@ -74,36 +73,22 @@ subroutine new_meta_config(self, table, error) end subroutine new_meta_config !> Check local schema for allowed entries - subroutine check(table, error) + logical function is_meta_package(key) !> Instance of the TOML data structure - type(toml_table), intent(inout) :: table - - !> Error handling - type(error_t), allocatable, intent(out) :: error - - type(toml_key), allocatable :: list(:) - integer :: ikey - - call table%get_keys(list) - - ! table can be empty - if (size(list) < 1) return + character(*), intent(in) :: key - do ikey = 1, size(list) - select case(list(ikey)%key) + select case (key) !> Supported metapackages case ("openmp","stdlib","mpi") - continue + is_meta_package = .true. case default - call syntax_error(error, "Key "//list(ikey)%key//" is not allowed in [metapackages]") - exit + is_meta_package = .false. - end select - end do + end select - end subroutine check + end function is_meta_package end module fpm_manifest_metapackages diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index 32c6fb3fda..f2a9100e0b 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -169,14 +169,6 @@ subroutine new_package(self, table, root, error) call new_build_config(self%build, child, error) if (allocated(error)) return - call get_value(table, "metapackages", child, requested=.true., stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error, "Type mismatch for metapackages entry, must be a table") - return - end if - call new_meta_config(self%meta, child, error) - if (allocated(error)) return - call get_value(table, "install", child, requested=.true., stat=stat) if (stat /= toml_stat%success) then call fatal_error(error, "Type mismatch for install entry, must be a table") @@ -210,13 +202,13 @@ subroutine new_package(self, table, root, error) call get_value(table, "dependencies", child, requested=.false.) if (associated(child)) then - call new_dependencies(self%dependency, child, root, error) + call new_dependencies(self%dependency, child, root, self%meta, error) if (allocated(error)) return end if call get_value(table, "dev-dependencies", child, requested=.false.) if (associated(child)) then - call new_dependencies(self%dev_dependency, child, root, error) + call new_dependencies(self%dev_dependency, child, root, error=error) if (allocated(error)) return end if @@ -340,7 +332,7 @@ subroutine check(table, error) case("version", "license", "author", "maintainer", "copyright", & & "description", "keywords", "categories", "homepage", "build", & & "dependencies", "dev-dependencies", "profiles", "test", "executable", & - & "example", "library", "install", "extra", "preprocess", "metapackages") + & "example", "library", "install", "extra", "preprocess") continue end select From 66477b19f000f336b46742e93abe5230d27b8b43 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Apr 2023 17:45:42 +0200 Subject: [PATCH 034/304] update example packages --- example_packages/metapackage_mpi/fpm.toml | 2 +- example_packages/metapackage_mpi_c/fpm.toml | 2 +- example_packages/metapackage_mpi_cpp/fpm.toml | 2 +- example_packages/metapackage_openmp/fpm.toml | 2 +- example_packages/metapackage_stdlib/fpm.toml | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/example_packages/metapackage_mpi/fpm.toml b/example_packages/metapackage_mpi/fpm.toml index 398aa0ee35..9deea93520 100644 --- a/example_packages/metapackage_mpi/fpm.toml +++ b/example_packages/metapackage_mpi/fpm.toml @@ -8,7 +8,7 @@ copyright = "Copyright 2023, Federico Perini and the fpm maintainers" [build] auto-executables = true -[metapackages] +[dependencies] mpi = true [install] diff --git a/example_packages/metapackage_mpi_c/fpm.toml b/example_packages/metapackage_mpi_c/fpm.toml index d5e18bac92..8fff9db364 100644 --- a/example_packages/metapackage_mpi_c/fpm.toml +++ b/example_packages/metapackage_mpi_c/fpm.toml @@ -9,7 +9,7 @@ copyright = "Copyright 2023, Federico Perini and the fpm maintainers" name = "test-mpi-c-main" main = "main.c" -[metapackages] +[dependencies] mpi = true [install] diff --git a/example_packages/metapackage_mpi_cpp/fpm.toml b/example_packages/metapackage_mpi_cpp/fpm.toml index da21a5d8a2..7b2c39d386 100644 --- a/example_packages/metapackage_mpi_cpp/fpm.toml +++ b/example_packages/metapackage_mpi_cpp/fpm.toml @@ -9,7 +9,7 @@ copyright = "Copyright 2023, Federico Perini and the fpm maintainers" name = "test-mpi-cpp" main = "main.cpp" -[metapackages] +[dependencies] mpi = true [install] diff --git a/example_packages/metapackage_openmp/fpm.toml b/example_packages/metapackage_openmp/fpm.toml index 051a88f2d2..9638da7b42 100644 --- a/example_packages/metapackage_openmp/fpm.toml +++ b/example_packages/metapackage_openmp/fpm.toml @@ -10,7 +10,7 @@ auto-executables = true auto-tests = true auto-examples = true -[metapackages] +[dependencies] openmp = true [install] diff --git a/example_packages/metapackage_stdlib/fpm.toml b/example_packages/metapackage_stdlib/fpm.toml index 8e11f13458..66df2f11fb 100644 --- a/example_packages/metapackage_stdlib/fpm.toml +++ b/example_packages/metapackage_stdlib/fpm.toml @@ -10,7 +10,7 @@ auto-executables = true auto-tests = true auto-examples = true -[metapackages] +[dependencies] stdlib = true [install] From 6d742677b4af2d572795c11faa287dd77dbc04f2 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 6 Apr 2023 11:09:07 +0200 Subject: [PATCH 035/304] generalize MPI wrapper test --- src/fpm_meta.f90 | 132 +++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 123 insertions(+), 9 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 5b0ecceab9..0cb9970e81 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -13,15 +13,15 @@ !> !> module fpm_meta -use fpm_strings, only: string_t -use fpm_error, only: error_t, fatal_error, syntax_error +use fpm_strings, only: string_t, len_trim +use fpm_error, only: error_t, fatal_error, syntax_error, fpm_stop use fpm_compiler use fpm_model use fpm_manifest_dependency, only: dependency_config_t use fpm_git, only : git_target_branch use fpm_manifest, only: package_config_t use fpm_environment, only: get_env,os_is_unix -use fpm_filesystem, only: run +use fpm_filesystem, only: run, get_temp_filename, getline use iso_fortran_env, only: stdout => output_unit implicit none @@ -334,9 +334,11 @@ subroutine init_mpi(this,compiler,error) !> Get all candidate MPI wrappers call mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) - print "('MPI wrapper founds: fortran=',i0,' c=',i0,' c++=',i0)", & + print "('MPI wrappers found: fortran=',i0,' c=',i0,' c++=',i0)", & size(fort_wrappers),size(c_wrappers),size(cpp_wrappers) + !> Match available wrappers with the current compiler + if (size(fort_wrappers)*size(c_wrappers)*size(cpp_wrappers)<=0) then call fatal_error(error,"cannot find MPI wrappers for "//compiler%name()//" compiler") return @@ -347,6 +349,16 @@ subroutine init_mpi(this,compiler,error) end subroutine init_mpi +!> Match +logical function mpi_compiler_match(wrapper,compiler) + type(string_t), intent(in) :: wrapper + type(compiler_t), intent(in) :: compiler + + + + +end function mpi_compiler_match + !> Return several mpi wrappers, and return subroutine mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) type(compiler_t), intent(in) :: compiler @@ -421,11 +433,103 @@ subroutine assert_mpi_wrappers(wrappers,verbose) end subroutine assert_mpi_wrappers +!> Simple call to execute_command_line involving one mpi* wrapper +subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_output) + type(string_t), intent(in) :: wrapper + type(string_t), intent(in), optional :: args(:) + logical, intent(in), optional :: verbose + integer, intent(out), optional :: exitcode + logical, intent(out), optional :: cmd_success + type(string_t), intent(out), optional :: screen_output + + logical :: echo_local + character(:), allocatable :: redirect_str,command,redirect,line + integer :: iunit,iarg,stat,cmdstat + + + if(present(verbose))then + echo_local=verbose + else + echo_local=.true. + end if + + ! No redirection and non-verbose output + if (present(screen_output)) then + redirect = get_temp_filename() + redirect_str = ">"//redirect//" 2>&1" + else + if (os_is_unix()) then + redirect_str = " >/dev/null 2>&1" + else + redirect_str = " >NUL 2>&1" + end if + end if + + ! Init command + command = wrapper%s + + add_arguments: if (present(args)) then + do iarg=1,size(args) + if (len_trim(args(iarg))<=0) cycle + command = trim(command)//' '//args(iarg)%s + end do + endif add_arguments + + + if (echo_local) print *, '+ ', command + + ! Test command + call execute_command_line(command//redirect_str,exitstat=stat,cmdstat=cmdstat) + + ! Command successful? + if (present(cmd_success)) cmd_success = cmdstat==0 + + ! Program exit code? + if (present(exitcode)) exitcode = stat + + ! Want screen output? + if (present(screen_output) .and. cmdstat==0) then + + allocate(character(len=0) :: screen_output%s) + + open(newunit=iunit,file=redirect,status='old',iostat=stat) + if (stat == 0)then + do + call getline(iunit, line, stat) + if (stat /= 0) exit + + screen_output%s = screen_output%s//new_line('a')//line + + write(*,'(A)') trim(line) + end do + + ! Close and delete file + close(iunit,status='delete') + + else + call fpm_stop(1,'cannot read temporary file from successful MPI wrapper') + endif + + end if + +end subroutine run_mpi_wrapper + !> Test if an MPI wrapper works logical function is_mpi_wrapper(wrapper,verbose) type(string_t), intent(in) :: wrapper logical, intent(in), optional :: verbose + call run_mpi_wrapper(wrapper,verbose=verbose,cmd_success=is_mpi_wrapper) + +end function is_mpi_wrapper + +!> Test if an MPI wrapper works +type(string_t) function mpi_wrapper_command(wrapper,command,verbose,error) + type(string_t), intent(in) :: wrapper + character(*), intent(in) :: command + logical, intent(in), optional :: verbose + type(error_t), allocatable, intent(out) :: error + logical :: echo_local character(:), allocatable :: redirect_str integer :: stat,cmdstat @@ -445,12 +549,22 @@ logical function is_mpi_wrapper(wrapper,verbose) if(echo_local) print *, '+ ', wrapper%s - ! Test command - call execute_command_line(wrapper%s//redirect_str, exitstat=stat,cmdstat=cmdstat) + select case (command) + case ('compiler') - ! Did this command work? - is_mpi_wrapper = cmdstat==0 + ! Return compiler name for the current MPI wrapper + call execute_command_line(wrapper%s//redirect_str, exitstat=stat,cmdstat=cmdstat) -end function is_mpi_wrapper + + + + case default; + call fatal_error(error,'an invalid MPI wrapper command ('//command//& + ') was invoked for wrapper <'//wrapper%s//'>.') + return + end select + + +end function mpi_wrapper_command end module fpm_meta From b099461c95c2e8fdc67b609f9b7433c0c9f5aec6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 6 Apr 2023 11:32:36 +0200 Subject: [PATCH 036/304] identify OpenMPI wrappers --- src/fpm_meta.f90 | 108 ++++++++++++++++++++++++++++++++++------------- 1 file changed, 79 insertions(+), 29 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 0cb9970e81..fc652a1bcc 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -68,6 +68,12 @@ module fpm_meta module procedure resolve_metapackage_model end interface resolve_metapackages +integer, parameter :: MPI_TYPE_NONE = 0 +integer, parameter :: MPI_TYPE_OPENMPI = 1 +integer, parameter :: MPI_TYPE_MPICH = 2 +integer, parameter :: MPI_TYPE_INTEL = 3 +integer, parameter :: MPI_TYPE_MSMPI = 4 + contains !> Clean the metapackage structure @@ -327,6 +333,7 @@ subroutine init_mpi(this,compiler,error) type(error_t), allocatable, intent(out) :: error type(string_t), allocatable :: c_wrappers(:),cpp_wrappers(:),fort_wrappers(:) + integer :: ifort,ic,icpp !> Cleanup call destroy(this) @@ -337,22 +344,38 @@ subroutine init_mpi(this,compiler,error) print "('MPI wrappers found: fortran=',i0,' c=',i0,' c++=',i0)", & size(fort_wrappers),size(c_wrappers),size(cpp_wrappers) - !> Match available wrappers with the current compiler - if (size(fort_wrappers)*size(c_wrappers)*size(cpp_wrappers)<=0) then call fatal_error(error,"cannot find MPI wrappers for "//compiler%name()//" compiler") return end if + ifort = mpi_compiler_match(fort_wrappers,compiler,error) + ic = mpi_compiler_match(c_wrappers,compiler,error) + icpp = mpi_compiler_match(cpp_wrappers,compiler,error) + call fatal_error(error,"MPI is being implemented, but not available yet") end subroutine init_mpi -!> Match -logical function mpi_compiler_match(wrapper,compiler) - type(string_t), intent(in) :: wrapper +!> Match one of the available compiler wrappers with the current compiler +integer function mpi_compiler_match(wrappers,compiler,error) + type(string_t), intent(in) :: wrappers(:) type(compiler_t), intent(in) :: compiler + type(error_t), allocatable, intent(out) :: error + + integer :: i + type(string_t) :: screen + + do i=1,size(wrappers) + + screen = mpi_wrapper_query(wrappers(i),'compiler',.false.,error) + if (allocated(error)) return + + end do + + + @@ -420,16 +443,16 @@ subroutine assert_mpi_wrappers(wrappers,verbose) logical, optional, intent(in) :: verbose integer :: i - logical, allocatable :: works(:) + integer, allocatable :: works(:) allocate(works(size(wrappers))) do i=1,size(wrappers) - works(i) = is_mpi_wrapper(wrappers(i),verbose) + works(i) = which_mpi_wrapper(wrappers(i),verbose) end do ! Filter out non-working wrappers - wrappers = pack(wrappers,works) + wrappers = pack(wrappers,works/=MPI_TYPE_NONE) end subroutine assert_mpi_wrappers @@ -515,47 +538,74 @@ subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_outp end subroutine run_mpi_wrapper !> Test if an MPI wrapper works -logical function is_mpi_wrapper(wrapper,verbose) +integer function which_mpi_wrapper(wrapper,verbose) type(string_t), intent(in) :: wrapper logical, intent(in), optional :: verbose + logical :: is_mpi_wrapper + integer :: stat + + ! Run mpi wrapper first call run_mpi_wrapper(wrapper,verbose=verbose,cmd_success=is_mpi_wrapper) -end function is_mpi_wrapper + if (is_mpi_wrapper) then + + ! Attempt to decipher which library this wrapper comes from. + + ! OpenMPI responds to '--showme' calls + call run_mpi_wrapper(wrapper,[string_t('--showme')],verbose,& + exitcode=stat,cmd_success=is_mpi_wrapper) + + if (stat==0 .and. is_mpi_wrapper) then + + which_mpi_wrapper = MPI_TYPE_OPENMPI + + else + + ! This MPI wrapper is of a currently unsupported library + which_mpi_wrapper = MPI_TYPE_NONE + + end if + + else + + which_mpi_wrapper = MPI_TYPE_NONE + + end if + +end function which_mpi_wrapper !> Test if an MPI wrapper works -type(string_t) function mpi_wrapper_command(wrapper,command,verbose,error) +type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result(screen) type(string_t), intent(in) :: wrapper character(*), intent(in) :: command logical, intent(in), optional :: verbose type(error_t), allocatable, intent(out) :: error - logical :: echo_local + logical :: success character(:), allocatable :: redirect_str - integer :: stat,cmdstat + integer :: stat,cmdstat,mpi - if(present(verbose))then - echo_local=verbose - else - echo_local=.true. - end if - - ! No redirection and non-verbose output - if (os_is_unix()) then - redirect_str = " >/dev/null 2>&1" - else - redirect_str = " >NUL 2>&1" + ! Get mpi type + mpi = which_mpi_wrapper(wrapper,verbose) + if (mpi==MPI_TYPE_NONE) then + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + return end if - if(echo_local) print *, '+ ', wrapper%s - select case (command) case ('compiler') - ! Return compiler name for the current MPI wrapper - call execute_command_line(wrapper%s//redirect_str, exitstat=stat,cmdstat=cmdstat) + ! Try one of the available "showme" options + call run_mpi_wrapper(wrapper,[string_t('--showme')],verbose=.true., & + exitcode=stat,cmd_success=success,screen_output=screen) + if (success .and. stat==0) then + print *, 'screen output = ',screen%s + else + print *, 'mpi wrapper unsuccessful' + end if case default; @@ -565,6 +615,6 @@ type(string_t) function mpi_wrapper_command(wrapper,command,verbose,error) end select -end function mpi_wrapper_command +end function mpi_wrapper_query end module fpm_meta From e2792d90fe94d8026b7790e777db41fc5c4d1481 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 6 Apr 2023 12:43:46 +0200 Subject: [PATCH 037/304] get libraries, include directories, linking directories from OpenMPI wrapper --- src/fpm_meta.f90 | 192 +++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 162 insertions(+), 30 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index fc652a1bcc..e3f844050b 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -34,6 +34,7 @@ module fpm_meta type, public :: metapackage_t logical :: has_link_libraries = .false. + logical :: has_link_dirs = .false. logical :: has_link_flags = .false. logical :: has_build_flags = .false. logical :: has_include_dirs = .false. @@ -42,6 +43,7 @@ module fpm_meta !> List of compiler flags and options to be added type(string_t) :: flags type(string_t) :: link_flags + type(string_t), allocatable :: incl_dirs(:) type(string_t), allocatable :: link_dirs(:) type(string_t), allocatable :: link_libs(:) @@ -82,6 +84,7 @@ elemental subroutine destroy(this) this%has_link_libraries = .false. this%has_link_flags = .false. + this%has_link_dirs = .false. this%has_build_flags = .false. this%has_include_dirs = .false. this%has_dependencies = .false. @@ -91,6 +94,7 @@ elemental subroutine destroy(this) if (allocated(this%link_dirs)) deallocate(this%link_dirs) if (allocated(this%link_libs)) deallocate(this%link_libs) if (allocated(this%dependency)) deallocate(this%dependency) + if (allocated(this%incl_dirs)) deallocate(this%incl_dirs) end subroutine destroy @@ -220,7 +224,7 @@ subroutine resolve_model(self,model,error) end if if (self%has_include_dirs) then - model%include_dirs = [model%include_dirs,self%link_dirs] + model%include_dirs = [model%include_dirs,self%incl_dirs] end if ! Dependencies are resolved in the package config @@ -332,29 +336,72 @@ subroutine init_mpi(this,compiler,error) type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error + logical, parameter :: verbose = .true. type(string_t), allocatable :: c_wrappers(:),cpp_wrappers(:),fort_wrappers(:) - integer :: ifort,ic,icpp + type(string_t) :: output + character(256) :: msg_out + character(len=:), allocatable :: tokens(:) + integer :: ifort,ic,icpp,i !> Cleanup call destroy(this) !> Get all candidate MPI wrappers call mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) - - print "('MPI wrappers found: fortran=',i0,' c=',i0,' c++=',i0)", & - size(fort_wrappers),size(c_wrappers),size(cpp_wrappers) + if (verbose) print 1, size(fort_wrappers),size(c_wrappers),size(cpp_wrappers) if (size(fort_wrappers)*size(c_wrappers)*size(cpp_wrappers)<=0) then call fatal_error(error,"cannot find MPI wrappers for "//compiler%name()//" compiler") return end if + !> Return an MPI wrapper that matches the current compiler ifort = mpi_compiler_match(fort_wrappers,compiler,error) - ic = mpi_compiler_match(c_wrappers,compiler,error) - icpp = mpi_compiler_match(cpp_wrappers,compiler,error) + if (allocated(error)) return + + !C, C++ not available yet + !ic = mpi_compiler_match(c_wrappers,compiler,error) + !icpp = mpi_compiler_match(cpp_wrappers,compiler,error) + + !> Build MPI dependency + if (ifort>0) then + + ! Get linking libraries + output = mpi_wrapper_query(fort_wrappers(ifort),'link',verbose,error) + if (allocated(error)) return + call split(output%s,tokens,delimiters=' ') + + this%has_link_libraries = size(tokens)>0 + this%link_libs = [(string_t(tokens(i)),i=1,size(tokens))] + + ! Get library directories + output = mpi_wrapper_query(fort_wrappers(ifort),'link_dirs',verbose,error) + if (allocated(error)) return + call split(output%s,tokens,delimiters=' ') + + this%has_link_dirs = size(tokens)>0 + this%link_dirs = [(string_t(tokens(i)),i=1,size(tokens))] + + ! Get include directories + output = mpi_wrapper_query(fort_wrappers(ifort),'incl_dirs',verbose,error) + if (allocated(error)) return + call split(output%s,tokens,delimiters=' ') + + this%has_include_dirs = size(tokens)>0 + this%incl_dirs = [(string_t(tokens(i)),i=1,size(tokens))] + + else - call fatal_error(error,"MPI is being implemented, but not available yet") + ! None of the available wrappers matched the current Fortran compiler + write(msg_out,1) size(fort_wrappers),compiler%fc + call fatal_error(error,trim(msg_out)) + return + endif + + + 1 format('MPI wrappers found: fortran=',i0,' c=',i0,' c++=',i0) + 2 format(' None out of ',i0,' valid MPI wrappers matches compiler ',a) end subroutine init_mpi @@ -366,19 +413,33 @@ integer function mpi_compiler_match(wrappers,compiler,error) integer :: i type(string_t) :: screen + character(128) :: msg_out + type(compiler_t) :: mpi_compiler + + mpi_compiler_match = 0 do i=1,size(wrappers) screen = mpi_wrapper_query(wrappers(i),'compiler',.false.,error) if (allocated(error)) return - end do - + ! Build compiler type + call new_compiler(mpi_compiler, screen%s,'','',echo=.true.,verbose=.true.) + ! Match found! + if (mpi_compiler%id == compiler%id) then + mpi_compiler_match = i + return + end if + end do + ! None of the available wrappers matched the current Fortran compiler + write(msg_out,1) size(wrappers),compiler%fc + call fatal_error(error,trim(msg_out)) + 1 format(' None out of ',i0,' valid MPI wrappers matches compiler ',a) end function mpi_compiler_match @@ -448,7 +509,7 @@ subroutine assert_mpi_wrappers(wrappers,verbose) allocate(works(size(wrappers))) do i=1,size(wrappers) - works(i) = which_mpi_wrapper(wrappers(i),verbose) + works(i) = which_mpi_library(wrappers(i),verbose) end do ! Filter out non-working wrappers @@ -537,8 +598,8 @@ subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_outp end subroutine run_mpi_wrapper -!> Test if an MPI wrapper works -integer function which_mpi_wrapper(wrapper,verbose) +!> Get MPI library type from the wrapper command. Currently, only OpenMPI is supported +integer function which_mpi_library(wrapper,verbose) type(string_t), intent(in) :: wrapper logical, intent(in), optional :: verbose @@ -558,22 +619,22 @@ integer function which_mpi_wrapper(wrapper,verbose) if (stat==0 .and. is_mpi_wrapper) then - which_mpi_wrapper = MPI_TYPE_OPENMPI + which_mpi_library = MPI_TYPE_OPENMPI else ! This MPI wrapper is of a currently unsupported library - which_mpi_wrapper = MPI_TYPE_NONE + which_mpi_library = MPI_TYPE_NONE end if else - which_mpi_wrapper = MPI_TYPE_NONE + which_mpi_library = MPI_TYPE_NONE end if -end function which_mpi_wrapper +end function which_mpi_library !> Test if an MPI wrapper works type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result(screen) @@ -587,26 +648,97 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( integer :: stat,cmdstat,mpi ! Get mpi type - mpi = which_mpi_wrapper(wrapper,verbose) - if (mpi==MPI_TYPE_NONE) then - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') - return - end if + mpi = which_mpi_library(wrapper,verbose) select case (command) + + ! Get MPI compiler name case ('compiler') - ! Try one of the available "showme" options - call run_mpi_wrapper(wrapper,[string_t('--showme')],verbose=.true., & - exitcode=stat,cmd_success=success,screen_output=screen) + select case (mpi) + case (MPI_TYPE_OPENMPI) + + ! --showme:command returns the build command of this wrapper + call run_mpi_wrapper(wrapper,[string_t('--showme:command')],verbose=.true., & + exitcode=stat,cmd_success=success,screen_output=screen) + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local OpenMPI library does not support --showme:command') + return + end if + + case default + + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + return + + end select + + ! Get a list of MPI linked libraries + case ('link') + + select case (mpi) + case (MPI_TYPE_OPENMPI) + + ! --showme:command returns the build command of this wrapper + call run_mpi_wrapper(wrapper,[string_t('--showme:libs')],verbose=.true., & + exitcode=stat,cmd_success=success,screen_output=screen) + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local OpenMPI library does not support --showme:link') + return + end if + + case default + + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + return + + end select + + ! Get a list of MPI library directories + case ('link_dirs') + + select case (mpi) + case (MPI_TYPE_OPENMPI) + + ! --showme:command returns the build command of this wrapper + call run_mpi_wrapper(wrapper,[string_t('--showme:libdirs')],verbose=.true., & + exitcode=stat,cmd_success=success,screen_output=screen) + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local OpenMPI library does not support --showme:libdirs') + return + end if + + case default + + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + return + + end select + + ! Get a list of include directories for the MPI headers/modules + case ('incl_dirs') + + select case (mpi) + case (MPI_TYPE_OPENMPI) + + ! --showme:command returns the build command of this wrapper + call run_mpi_wrapper(wrapper,[string_t('--showme:incdirs')],verbose=.true., & + exitcode=stat,cmd_success=success,screen_output=screen) + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local OpenMPI library does not support --showme:incdirs') + return + end if - if (success .and. stat==0) then + case default - print *, 'screen output = ',screen%s - else - print *, 'mpi wrapper unsuccessful' - end if + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + return + end select case default; call fatal_error(error,'an invalid MPI wrapper command ('//command//& From 1a39ade71323187c6eb76301927084e47e21cc9b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 6 Apr 2023 13:02:35 +0200 Subject: [PATCH 038/304] simplify to build/link flags (link dirs not supported by fpm) --- src/fpm_meta.f90 | 53 ++++++++++++++++++++++++++++-------------------- 1 file changed, 31 insertions(+), 22 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index e3f844050b..dabef9dcfa 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -366,29 +366,15 @@ subroutine init_mpi(this,compiler,error) !> Build MPI dependency if (ifort>0) then - ! Get linking libraries - output = mpi_wrapper_query(fort_wrappers(ifort),'link',verbose,error) + ! Get linking flags + this%link_flags = mpi_wrapper_query(fort_wrappers(ifort),'link',verbose,error) if (allocated(error)) return - call split(output%s,tokens,delimiters=' ') + this%has_link_flags = len_trim(this%link_flags)>0 - this%has_link_libraries = size(tokens)>0 - this%link_libs = [(string_t(tokens(i)),i=1,size(tokens))] - - ! Get library directories - output = mpi_wrapper_query(fort_wrappers(ifort),'link_dirs',verbose,error) - if (allocated(error)) return - call split(output%s,tokens,delimiters=' ') - - this%has_link_dirs = size(tokens)>0 - this%link_dirs = [(string_t(tokens(i)),i=1,size(tokens))] - - ! Get include directories - output = mpi_wrapper_query(fort_wrappers(ifort),'incl_dirs',verbose,error) + ! Get build flags + this%flags = mpi_wrapper_query(fort_wrappers(ifort),'flags',verbose,error) if (allocated(error)) return - call split(output%s,tokens,delimiters=' ') - - this%has_include_dirs = size(tokens)>0 - this%incl_dirs = [(string_t(tokens(i)),i=1,size(tokens))] + this%has_build_flags = len_trim(this%flags)>0 else @@ -674,14 +660,37 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( end select - ! Get a list of MPI linked libraries + + ! Get a list of additional compiler flags + case ('flags') + + select case (mpi) + case (MPI_TYPE_OPENMPI) + + ! --showme:command returns the build command of this wrapper + call run_mpi_wrapper(wrapper,[string_t('--showme:compile')],verbose=.true., & + exitcode=stat,cmd_success=success,screen_output=screen) + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local OpenMPI library does not support --showme:compile') + return + end if + + case default + + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + return + + end select + + ! Get a list of additional linker flags case ('link') select case (mpi) case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('--showme:libs')],verbose=.true., & + call run_mpi_wrapper(wrapper,[string_t('--showme:link')],verbose=.true., & exitcode=stat,cmd_success=success,screen_output=screen) if (stat/=0 .or. .not.success) then From 9a56db65edb1af290da5a0193c6c3e864eebc274 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 6 Apr 2023 14:33:28 +0200 Subject: [PATCH 039/304] remove new line characters from the wrapper flags --- src/fpm_meta.f90 | 46 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 45 insertions(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index dabef9dcfa..1f067e13ae 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -322,6 +322,9 @@ subroutine resolve_metapackage_model(model,package,error) ! MPI if (package%meta%mpi) then + + print *, 'resolving MPI...' + call add_metapackage_model(model,"mpi",error) if (allocated(error)) return call add_metapackage_config(package,model%compiler,"mpi",error) @@ -371,11 +374,17 @@ subroutine init_mpi(this,compiler,error) if (allocated(error)) return this%has_link_flags = len_trim(this%link_flags)>0 + ! Add heading space + this%link_flags = string_t(' '//this%link_flags%s) + ! Get build flags this%flags = mpi_wrapper_query(fort_wrappers(ifort),'flags',verbose,error) if (allocated(error)) return this%has_build_flags = len_trim(this%flags)>0 + ! Add heading space + this%flags = string_t(' '//this%flags%s) + else ! None of the available wrappers matched the current Fortran compiler @@ -410,7 +419,7 @@ integer function mpi_compiler_match(wrappers,compiler,error) if (allocated(error)) return ! Build compiler type - call new_compiler(mpi_compiler, screen%s,'','',echo=.true.,verbose=.true.) + call new_compiler(mpi_compiler,screen%s,'','',echo=.true.,verbose=.true.) ! Match found! if (mpi_compiler%id == compiler%id) then @@ -676,6 +685,8 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( return end if + call remove_new_lines(screen) + case default call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') @@ -698,6 +709,8 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( return end if + call remove_new_lines(screen) + case default call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') @@ -758,4 +771,35 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( end function mpi_wrapper_query +! Remove all new line characters from the current string +subroutine remove_new_lines(string) + type(string_t), intent(inout) :: string + + integer :: feed,length + + if (.not.allocated(string%s)) return + + + length = len(string%s) + feed = scan(string%s,new_line('a')) + + do while (length>0 .and. feed>0) + + if (length==1) then + string = string_t("") + elseif (feed==1) then + string%s = string%s(2:length) + elseif (feed==length) then + string%s = string%s(1:length-1) + else + string%s = string%s(1:feed-1)//string%s(feed+1:length) + end if + + length = len(string%s) + feed = scan(string%s,new_line('a')) + + end do + +end subroutine remove_new_lines + end module fpm_meta From ff2744cefc363d782fee28800488c7106a3db838 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 6 Apr 2023 14:34:22 +0200 Subject: [PATCH 040/304] remove link directories (not supported by fpm) --- src/fpm_meta.f90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 1f067e13ae..6135dfd07e 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -34,7 +34,6 @@ module fpm_meta type, public :: metapackage_t logical :: has_link_libraries = .false. - logical :: has_link_dirs = .false. logical :: has_link_flags = .false. logical :: has_build_flags = .false. logical :: has_include_dirs = .false. @@ -44,7 +43,6 @@ module fpm_meta type(string_t) :: flags type(string_t) :: link_flags type(string_t), allocatable :: incl_dirs(:) - type(string_t), allocatable :: link_dirs(:) type(string_t), allocatable :: link_libs(:) !> List of Development dependency meta data. @@ -84,14 +82,12 @@ elemental subroutine destroy(this) this%has_link_libraries = .false. this%has_link_flags = .false. - this%has_link_dirs = .false. this%has_build_flags = .false. this%has_include_dirs = .false. this%has_dependencies = .false. if (allocated(this%flags%s)) deallocate(this%flags%s) if (allocated(this%link_flags%s)) deallocate(this%link_flags%s) - if (allocated(this%link_dirs)) deallocate(this%link_dirs) if (allocated(this%link_libs)) deallocate(this%link_libs) if (allocated(this%dependency)) deallocate(this%dependency) if (allocated(this%incl_dirs)) deallocate(this%incl_dirs) From 8ae464eff9ec3136d57d5f1c0a1d0476a0d37b06 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 6 Apr 2023 15:49:22 +0200 Subject: [PATCH 041/304] add fortran-regex dependency --- fpm.toml | 2 ++ src/fpm_meta.f90 | 62 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 64 insertions(+) diff --git a/fpm.toml b/fpm.toml index ec70e34043..93419d38cc 100644 --- a/fpm.toml +++ b/fpm.toml @@ -10,6 +10,8 @@ toml-f.git = "https://github.com/toml-f/toml-f" toml-f.rev = "54686e45993f3a9a1d05d5c7419f39e7d5a4eb3f" M_CLI2.git = "https://github.com/urbanjost/M_CLI2.git" M_CLI2.rev = "7264878cdb1baff7323cc48596d829ccfe7751b8" +fortran-regex.git = "https://github.com/perazz/fortran-regex" +fortran-regex.tag = "1.1.0" [[test]] name = "cli-test" diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 6135dfd07e..06470cf848 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -22,7 +22,9 @@ module fpm_meta use fpm_manifest, only: package_config_t use fpm_environment, only: get_env,os_is_unix use fpm_filesystem, only: run, get_temp_filename, getline +use fpm_versioning, only: version_t, new_version use iso_fortran_env, only: stdout => output_unit +use regex_module, only: regex implicit none @@ -33,6 +35,9 @@ module fpm_meta !> Type for describing a source file type, public :: metapackage_t + !> Package version (if supported) + type(version_t), allocatable :: version + logical :: has_link_libraries = .false. logical :: has_link_flags = .false. logical :: has_build_flags = .false. @@ -80,12 +85,14 @@ module fpm_meta elemental subroutine destroy(this) class(metapackage_t), intent(inout) :: this + this%has_link_libraries = .false. this%has_link_flags = .false. this%has_build_flags = .false. this%has_include_dirs = .false. this%has_dependencies = .false. + if (allocated(this%version)) deallocate(this%version) if (allocated(this%flags%s)) deallocate(this%flags%s) if (allocated(this%link_flags%s)) deallocate(this%link_flags%s) if (allocated(this%link_libs)) deallocate(this%link_libs) @@ -338,6 +345,7 @@ subroutine init_mpi(this,compiler,error) logical, parameter :: verbose = .true. type(string_t), allocatable :: c_wrappers(:),cpp_wrappers(:),fort_wrappers(:) type(string_t) :: output + type(version_t) :: version character(256) :: msg_out character(len=:), allocatable :: tokens(:) integer :: ifort,ic,icpp,i @@ -381,6 +389,15 @@ subroutine init_mpi(this,compiler,error) ! Add heading space this%flags = string_t(' '//this%flags%s) + ! Get library version + version = mpi_version_get(fort_wrappers(ifort),error) + if (allocated(error)) then + return + else + allocate(this%version,source=version) + end if + + else ! None of the available wrappers matched the current Fortran compiler @@ -434,6 +451,27 @@ integer function mpi_compiler_match(wrappers,compiler,error) end function mpi_compiler_match +!> Return library version from the MPI wrapper command +type(version_t) function mpi_version_get(wrapper,error) + type(string_t), intent(in) :: wrapper + type(error_t), allocatable, intent(out) :: error + + type(string_t) :: version_line,version_string + integer :: i,length + + ! Get version string + version_line = mpi_wrapper_query(wrapper,'version',error=error) + if (allocated(error)) return + + ! Extract version + version_string = regex(version_line%s,'',length=length) + + + ! Parse version + call new_version(mpi_version_get,version_s%s,error) + +end function mpi_version_get + !> Return several mpi wrappers, and return subroutine mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) type(compiler_t), intent(in) :: compiler @@ -758,6 +796,30 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( end select + ! Retrieve library version + case ('version') + + select case (mpi) + case (MPI_TYPE_OPENMPI) + + ! --showme:command returns the build command of this wrapper + call run_mpi_wrapper(wrapper,[string_t('--showme:version')],verbose=.true., & + exitcode=stat,cmd_success=success,screen_output=screen) + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local OpenMPI library does not support --showme:version') + return + else + call remove_new_lines(screen) + end if + + case default + + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + return + + end select + case default; call fatal_error(error,'an invalid MPI wrapper command ('//command//& ') was invoked for wrapper <'//wrapper%s//'>.') From e456509eba152216ed27fc64f7954e5a33f6d9b7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 6 Apr 2023 17:49:01 +0200 Subject: [PATCH 042/304] query OpenMPI version and save in metapackage_t --- src/fpm_meta.f90 | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 06470cf848..a9800d5f5e 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -397,7 +397,6 @@ subroutine init_mpi(this,compiler,error) allocate(this%version,source=version) end if - else ! None of the available wrappers matched the current Fortran compiler @@ -456,19 +455,14 @@ type(version_t) function mpi_version_get(wrapper,error) type(string_t), intent(in) :: wrapper type(error_t), allocatable, intent(out) :: error - type(string_t) :: version_line,version_string - integer :: i,length + type(string_t) :: version_line ! Get version string version_line = mpi_wrapper_query(wrapper,'version',error=error) if (allocated(error)) return - ! Extract version - version_string = regex(version_line%s,'',length=length) - - - ! Parse version - call new_version(mpi_version_get,version_s%s,error) + ! Wrap to object + call new_version(mpi_version_get,version_line%s,error) end function mpi_version_get @@ -674,7 +668,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( logical :: success character(:), allocatable :: redirect_str - integer :: stat,cmdstat,mpi + integer :: stat,cmdstat,mpi,ire,length ! Get mpi type mpi = which_mpi_library(wrapper,verbose) @@ -813,6 +807,20 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( call remove_new_lines(screen) end if + ! Extract version + ire = regex(screen%s,'\d+.\d+.\d+',length=length) + + if (ire>0 .and. length>0) then + + ! Parse version into the object (this should always work) + screen%s = screen%s(ire:ire+length-1) + + else + + call syntax_error(error,'cannot retrieve OpenMPI library version.') + + end if + case default call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') From 39ae27d6ad94d35e79e97da07b88d2a4e5ef1939 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 20 Apr 2023 01:38:23 -0500 Subject: [PATCH 043/304] fix merged CI Script --- ci/run_tests.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 4a6645c6d3..e937b421b0 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -219,6 +219,7 @@ test $EXIT_CODE -eq 0 EXIT_CODE=0 "$fpm" run || EXIT_CODE=$? test $EXIT_CODE -eq 0 +popd # test dependency priority pushd dependency_priority @@ -243,7 +244,6 @@ if [[ -z "$(grep Update update.log)" ]]; then echo "No updated dependencies after 'fpm update --clean'"; exit 1; fi - popd # Cleanup From 82e268dd90119ef469e74466eb57f85cc191c776 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 20 Apr 2023 04:14:00 -0500 Subject: [PATCH 044/304] MS-MPI: search for paths, resolve paths with spaces to DOS --- src/fpm_meta.f90 | 243 ++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 199 insertions(+), 44 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index a9800d5f5e..f56df543da 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -21,8 +21,9 @@ module fpm_meta use fpm_git, only : git_target_branch use fpm_manifest, only: package_config_t use fpm_environment, only: get_env,os_is_unix -use fpm_filesystem, only: run, get_temp_filename, getline +use fpm_filesystem, only: run, get_temp_filename, getline, exists use fpm_versioning, only: version_t, new_version +use fpm_os, only: get_absolute_path use iso_fortran_env, only: stdout => output_unit use regex_module, only: regex @@ -79,6 +80,9 @@ module fpm_meta integer, parameter :: MPI_TYPE_INTEL = 3 integer, parameter :: MPI_TYPE_MSMPI = 4 +!> Debugging information +logical, parameter, private :: verbose = .true. + contains !> Clean the metapackage structure @@ -338,17 +342,19 @@ end subroutine resolve_metapackage_model !> Initialize MPI metapackage for the current system subroutine init_mpi(this,compiler,error) + use iso_fortran_env, only: compiler_version,compiler_options class(metapackage_t), intent(inout) :: this type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error - logical, parameter :: verbose = .true. + type(string_t), allocatable :: c_wrappers(:),cpp_wrappers(:),fort_wrappers(:) type(string_t) :: output - type(version_t) :: version character(256) :: msg_out character(len=:), allocatable :: tokens(:) - integer :: ifort,ic,icpp,i + integer :: mpif90,ic,icpp,i + logical :: wcfit,found + !> Cleanup call destroy(this) @@ -357,60 +363,209 @@ subroutine init_mpi(this,compiler,error) call mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) if (verbose) print 1, size(fort_wrappers),size(c_wrappers),size(cpp_wrappers) - if (size(fort_wrappers)*size(c_wrappers)*size(cpp_wrappers)<=0) then - call fatal_error(error,"cannot find MPI wrappers for "//compiler%name()//" compiler") - return + wcfit = wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,error) + + if (allocated(error) .or. .not.wcfit) then + + !> No wrapper compiler fit. Are we on Windows? use MSMPI-specific search + found = msmpi_init(this) + + !> All attempts failed + if (.not.found) then + call fatal_error(error,"cannot find MPI wrappers or libraries for "//compiler%name()//" compiler") + return + endif + + else + + !> Initialize MPI package from wrapper command + call init_mpi_from_wrapper(this,compiler,fort_wrappers(mpif90),error) + if (allocated(error)) return + end if - !> Return an MPI wrapper that matches the current compiler - ifort = mpi_compiler_match(fort_wrappers,compiler,error) - if (allocated(error)) return + 1 format('MPI wrappers found: fortran=',i0,' c=',i0,' c++=',i0) - !C, C++ not available yet - !ic = mpi_compiler_match(c_wrappers,compiler,error) - !icpp = mpi_compiler_match(cpp_wrappers,compiler,error) +end subroutine init_mpi - !> Build MPI dependency - if (ifort>0) then +!> Check if we're on a 64-bit environment +!> Accept answer from https://stackoverflow.com/questions/49141093/get-system-information-with-fortran +logical function is_64bit_environment() + use iso_c_binding, only: c_intptr_t + integer, parameter :: nbits = bit_size(0_c_intptr_t) + is_64bit_environment = nbits==64 +end function is_64bit_environment + +!> Check if there is a wrapper-compiler fit +logical function wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,error) + type(string_t), allocatable, intent(in) :: fort_wrappers(:),c_wrappers(:),cpp_wrappers(:) + type(compiler_t), intent(in) :: compiler + type(error_t), allocatable, intent(out) :: error - ! Get linking flags - this%link_flags = mpi_wrapper_query(fort_wrappers(ifort),'link',verbose,error) - if (allocated(error)) return - this%has_link_flags = len_trim(this%link_flags)>0 + logical :: has_wrappers + integer :: mpif90 - ! Add heading space - this%link_flags = string_t(' '//this%link_flags%s) + wrapper_compiler_fit = .false. - ! Get build flags - this%flags = mpi_wrapper_query(fort_wrappers(ifort),'flags',verbose,error) - if (allocated(error)) return - this%has_build_flags = len_trim(this%flags)>0 + !> Were any wrappers found? + has_wrappers = size(fort_wrappers)*size(c_wrappers)*size(cpp_wrappers)>0 - ! Add heading space - this%flags = string_t(' '//this%flags%s) + if (has_wrappers) then - ! Get library version - version = mpi_version_get(fort_wrappers(ifort),error) - if (allocated(error)) then - return - else - allocate(this%version,source=version) - end if + !> Find an MPI wrapper that matches the current compiler + mpif90 = mpi_compiler_match(fort_wrappers,compiler,error) + if (allocated(error)) return + + !> Was a valid wrapper found? + wrapper_compiler_fit = mpif90>0 + + endif + +end function wrapper_compiler_fit + +!> Check if a local MS-MPI SDK build is found +logical function msmpi_init(this) result(found) + class(metapackage_t), intent(inout) :: this + + character(len=:), allocatable :: incdir,libdir,post,reall + type(error_t), allocatable :: error + + + !> Default: not found + found = .false. + + if (get_os_type()==OS_WINDOWS) then + + !> Find include and library directories + incdir = get_env('MSMPI_INC') + if (is_64bit_environment()) then + libdir = get_env('MSMPI_LIB64') + post = 'x64' + else + libdir = get_env('MSMPI_LIB32') + post = 'x86' + end if + + if (verbose) print 1, 'include',incdir,exists(incdir) + if (verbose) print 1, 'library',libdir,exists(libdir) + + ! Both directories need be defined and existent + if (len_trim(incdir)<=0 .or. len_trim(libdir)<=0) return + if (.not.exists(incdir) .or. .not.exists(libdir)) return + + ! Init ms-mpi + call destroy(this) + + this%has_link_flags = .true. + this%link_flags = string_t(' -l'//get_dos_path(libdir//'msmpi')// & + ' -l'//get_dos_path(libdir//'msmpifec')) ! fortran-only + + this%has_include_dirs = .true. + this%incl_dirs = [string_t(get_dos_path(incdir)), & + string_t(get_dos_path(incdir//post))] + + call get_absolute_path(libdir//'msmpi.lib', reall, error) + if (allocated(error)) stop 'cannot get realpath '//error%message + print *, 'real pach= ',reall + + found = .true. else - ! None of the available wrappers matched the current Fortran compiler - write(msg_out,1) size(fort_wrappers),compiler%fc - call fatal_error(error,trim(msg_out)) - return + !> Not on Windows + found = .false. - endif + end if + 1 format('MSMSPI ',a,' directory: PATH=',a,' EXISTS=',l1) - 1 format('MPI wrappers found: fortran=',i0,' c=',i0,' c++=',i0) - 2 format(' None out of ',i0,' valid MPI wrappers matches compiler ',a) +end function msmpi_init -end subroutine init_mpi +!> Ensure a windows path is converted to a DOS path if it contains spaces +function get_dos_path(path) + character(len=*), intent(in) :: path + character(len=:), allocatable :: get_dos_path + + character(:), allocatable :: redirect,screen_output,line + integer :: stat,cmdstat,iunit + + ! Trim path first + get_dos_path = trim(path) + + !> No need to convert if there are no spaces + if (scan(get_dos_path,' ')<=0) return + + + redirect = get_temp_filename() + call execute_command_line('cmd /c for %A in ("'//path//'") do @echo %~sA >'//redirect//' 2>&1',& + exitstat=stat,cmdstat=cmdstat) + + !> Read screen output + if (cmdstat==0) then + + allocate(character(len=0) :: screen_output) + open(newunit=iunit,file=redirect,status='old',iostat=stat) + if (stat == 0)then + do + call getline(iunit, line, stat) + if (stat /= 0) exit + screen_output = screen_output//line//' ' + end do + + ! Close and delete file + close(iunit,status='delete') + + else + call fpm_stop(1,'cannot read temporary file from successful DOS path evaluation') + endif + + else + + call fpm_stop(1,'cannot convert windows path to DOS path') + + end if + + get_dos_path = trim(adjustl(screen_output)) + +end function get_dos_path + +!> Initialize an MPI metapackage from a valid wrapper command ('mpif90', etc...) +subroutine init_mpi_from_wrapper(this,compiler,fort_wrapper,error) + class(metapackage_t), intent(inout) :: this + type(compiler_t), intent(in) :: compiler + type(string_t), intent(in) :: fort_wrapper + type(error_t), allocatable, intent(out) :: error + + type(version_t) :: version + + ! Cleanup structure + call destroy(this) + + ! Get linking flags + this%link_flags = mpi_wrapper_query(fort_wrapper,'link',verbose,error) + if (allocated(error)) return + this%has_link_flags = len_trim(this%link_flags)>0 + + ! Add heading space + this%link_flags = string_t(' '//this%link_flags%s) + + ! Get build flags + this%flags = mpi_wrapper_query(fort_wrapper,'flags',verbose,error) + if (allocated(error)) return + this%has_build_flags = len_trim(this%flags)>0 + + ! Add heading space + this%flags = string_t(' '//this%flags%s) + + ! Get library version + version = mpi_version_get(fort_wrapper,error) + if (allocated(error)) then + return + else + allocate(this%version,source=version) + end if + +end subroutine init_mpi_from_wrapper !> Match one of the available compiler wrappers with the current compiler integer function mpi_compiler_match(wrappers,compiler,error) @@ -427,7 +582,7 @@ integer function mpi_compiler_match(wrappers,compiler,error) do i=1,size(wrappers) - screen = mpi_wrapper_query(wrappers(i),'compiler',.false.,error) + screen = mpi_wrapper_query(wrappers(i),'compiler',verbose=.false.,error=error) if (allocated(error)) return ! Build compiler type @@ -607,7 +762,7 @@ subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_outp screen_output%s = screen_output%s//new_line('a')//line - write(*,'(A)') trim(line) + if (verbose) write(*,'(A)') trim(line) end do ! Close and delete file From d5ef9d6315b2762294b025269a10103c276dc97c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 20 Apr 2023 04:23:51 -0500 Subject: [PATCH 045/304] fix MS-MPI paths --- src/fpm_meta.f90 | 57 ++++++++++++++++++++++++------------------------ 1 file changed, 29 insertions(+), 28 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index f56df543da..3e68f2e40e 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -457,17 +457,13 @@ logical function msmpi_init(this) result(found) call destroy(this) this%has_link_flags = .true. - this%link_flags = string_t(' -l'//get_dos_path(libdir//'msmpi')// & - ' -l'//get_dos_path(libdir//'msmpifec')) ! fortran-only + this%link_flags = string_t(' -l'//get_dos_path(join_path(libdir,'msmpi'))// & + ' -l'//get_dos_path(join_path(libdir,'msmpifec'))) ! fortran-only this%has_include_dirs = .true. this%incl_dirs = [string_t(get_dos_path(incdir)), & string_t(get_dos_path(incdir//post))] - call get_absolute_path(libdir//'msmpi.lib', reall, error) - if (allocated(error)) stop 'cannot get realpath '//error%message - print *, 'real pach= ',reall - found = .true. else @@ -487,46 +483,51 @@ function get_dos_path(path) character(len=:), allocatable :: get_dos_path character(:), allocatable :: redirect,screen_output,line - integer :: stat,cmdstat,iunit + integer :: stat,cmdstat,iunit,last ! Trim path first get_dos_path = trim(path) !> No need to convert if there are no spaces - if (scan(get_dos_path,' ')<=0) return + has_spaces: if (scan(get_dos_path,' ')>0) then + redirect = get_temp_filename() + call execute_command_line('cmd /c for %A in ("'//path//'") do @echo %~sA >'//redirect//' 2>&1',& + exitstat=stat,cmdstat=cmdstat) - redirect = get_temp_filename() - call execute_command_line('cmd /c for %A in ("'//path//'") do @echo %~sA >'//redirect//' 2>&1',& - exitstat=stat,cmdstat=cmdstat) + !> Read screen output + if (cmdstat==0) then - !> Read screen output - if (cmdstat==0) then + allocate(character(len=0) :: screen_output) + open(newunit=iunit,file=redirect,status='old',iostat=stat) + if (stat == 0)then + do + call getline(iunit, line, stat) + if (stat /= 0) exit + screen_output = screen_output//line//' ' + end do - allocate(character(len=0) :: screen_output) - open(newunit=iunit,file=redirect,status='old',iostat=stat) - if (stat == 0)then - do - call getline(iunit, line, stat) - if (stat /= 0) exit - screen_output = screen_output//line//' ' - end do + ! Close and delete file + close(iunit,status='delete') - ! Close and delete file - close(iunit,status='delete') + else + call fpm_stop(1,'cannot read temporary file from successful DOS path evaluation') + endif else - call fpm_stop(1,'cannot read temporary file from successful DOS path evaluation') - endif - else + call fpm_stop(1,'cannot convert windows path to DOS path') - call fpm_stop(1,'cannot convert windows path to DOS path') + end if - end if + endif has_spaces + !> Ensure there are no trailing slashes get_dos_path = trim(adjustl(screen_output)) + last = len_trim(get_dos_path) + if (last>1 .and. get_dos_path(last:last)=='/' .or. get_dos_path(last:last)=='\') get_dos_path = get_dos_path(1:last-1) + end function get_dos_path !> Initialize an MPI metapackage from a valid wrapper command ('mpif90', etc...) From f5125e933e6891933c8f92354356923edebc1597 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 20 Apr 2023 04:59:34 -0500 Subject: [PATCH 046/304] allow invalid BOZ in mpif.h with gfortran --- src/fpm_meta.f90 | 114 ++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 99 insertions(+), 15 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 3e68f2e40e..11d493a65a 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -342,7 +342,6 @@ end subroutine resolve_metapackage_model !> Initialize MPI metapackage for the current system subroutine init_mpi(this,compiler,error) - use iso_fortran_env, only: compiler_version,compiler_options class(metapackage_t), intent(inout) :: this type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error @@ -368,7 +367,8 @@ subroutine init_mpi(this,compiler,error) if (allocated(error) .or. .not.wcfit) then !> No wrapper compiler fit. Are we on Windows? use MSMPI-specific search - found = msmpi_init(this) + found = msmpi_init(this,compiler,error) + if (allocated(error)) return !> All attempts failed if (.not.found) then @@ -424,12 +424,13 @@ logical function wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,comp end function wrapper_compiler_fit !> Check if a local MS-MPI SDK build is found -logical function msmpi_init(this) result(found) +logical function msmpi_init(this,compiler,error) result(found) class(metapackage_t), intent(inout) :: this + type(compiler_t), intent(in) :: compiler + type(error_t), allocatable, intent(out) :: error character(len=:), allocatable :: incdir,libdir,post,reall - type(error_t), allocatable :: error - + type(version_t) :: ver,ver10 !> Default: not found found = .false. @@ -457,15 +458,36 @@ logical function msmpi_init(this) result(found) call destroy(this) this%has_link_flags = .true. - this%link_flags = string_t(' -l'//get_dos_path(join_path(libdir,'msmpi'))// & - ' -l'//get_dos_path(join_path(libdir,'msmpifec'))) ! fortran-only + this%link_flags = string_t(' -l'//get_dos_path(join_path(libdir,'msmpi'),error)// & + ' -l'//get_dos_path(join_path(libdir,'msmpifec'),error)) ! fortran-only + if (allocated(error)) return this%has_include_dirs = .true. - this%incl_dirs = [string_t(get_dos_path(incdir)), & - string_t(get_dos_path(incdir//post))] + this%incl_dirs = [string_t(get_dos_path(incdir,error)), & + string_t(get_dos_path(incdir//post,error))] + if (allocated(error)) return found = .true. + ! gfortran>=10 is incompatible with the old-style mpif.h MS-MPI headers. + ! If so, add flags to allow old-style BOZ constants in mpif.h + + allow_BOZ: if (compiler%id==id_gcc) then + ver = compiler_get_version(compiler,error) + if (allocated(error)) return + + call new_version(ver10,'10.0.0',error) + if (allocated(error)) return + + if (ver>=ver10) then + this%has_build_flags = .true. + this%flags = string_t(' -fallow-invalid-boz') + + end if + + endif allow_BOZ + + else !> Not on Windows @@ -477,9 +499,68 @@ logical function msmpi_init(this) result(found) end function msmpi_init +!> Return compiler version +type(version_t) function compiler_get_version(self,error) + type(compiler_t), intent(in) :: self + type(error_t), allocatable, intent(out) :: error + + character(:), allocatable :: tmp_file,screen_output,line + integer :: stat,iunit,ire,length + + select case (self%id) + case (id_gcc) + + tmp_file = get_temp_filename() + + call run(self%fc // " --version ", echo=self%echo, verbose=self%verbose, redirect=tmp_file, exitstat=stat) + if (stat/=0) then + call fatal_error(error,'compiler_get_version failed for '//self%fc) + return + end if + + allocate(character(len=0) :: screen_output) + open(newunit=iunit,file=tmp_file,status='old',iostat=stat) + if (stat == 0)then + + do + call getline(iunit, line, stat) + if (stat /= 0) exit + screen_output = screen_output//' '//line//' ' + end do + + ! Close and delete file + close(iunit,status='delete') + + else + call fatal_error(error,'cannot read temporary file from successful compiler_get_version') + return + endif + + ! Extract version + ire = regex(screen_output,'\d+.\d+.\d+',length=length) + + if (ire>0 .and. length>0) then + ! Parse version into the object (this should always work) + screen_output = screen_output(ire:ire+length-1) + else + call syntax_error(error,'cannot retrieve '//self%fc//' compiler version.') + return + end if + + ! Wrap to object + call new_version(compiler_get_version,screen_output,error) + + case default + call fatal_error(error,'compiler_get_version not yet implemented for compiler '//self%fc) + return + end select + +end function compiler_get_version + !> Ensure a windows path is converted to a DOS path if it contains spaces -function get_dos_path(path) +function get_dos_path(path,error) character(len=*), intent(in) :: path + type(error_t), allocatable, intent(out) :: error character(len=:), allocatable :: get_dos_path character(:), allocatable :: redirect,screen_output,line @@ -496,11 +577,12 @@ function get_dos_path(path) exitstat=stat,cmdstat=cmdstat) !> Read screen output - if (cmdstat==0) then + command_OK: if (cmdstat==0 .and. stat==0) then allocate(character(len=0) :: screen_output) open(newunit=iunit,file=redirect,status='old',iostat=stat) if (stat == 0)then + do call getline(iunit, line, stat) if (stat /= 0) exit @@ -511,14 +593,16 @@ function get_dos_path(path) close(iunit,status='delete') else - call fpm_stop(1,'cannot read temporary file from successful DOS path evaluation') + call fatal_error(error,'cannot read temporary file from successful DOS path evaluation') + return endif - else + else command_OK - call fpm_stop(1,'cannot convert windows path to DOS path') + call fatal_error(error,'unsuccessful Windows->DOS path command') + return - end if + end if command_OK endif has_spaces From b354bc3adb5b6f2ca0cd6e57b196fedfd440543a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 20 Apr 2023 04:59:38 -0500 Subject: [PATCH 047/304] typo --- example_packages/metapackage_mpi/app/main.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/example_packages/metapackage_mpi/app/main.f90 b/example_packages/metapackage_mpi/app/main.f90 index f3c3bde606..c8569f4ed3 100644 --- a/example_packages/metapackage_mpi/app/main.f90 +++ b/example_packages/metapackage_mpi/app/main.f90 @@ -18,7 +18,7 @@ program with_mpi call MPI_Comm_rank(MPI_COMM_WORLD, cpuid, ierror) if (ierror/=0) stop RANK_ERROR - print "('Hello, mpi world from rank ',i0,' of ',i0,'!')", cpuid+1,ncpu + print "('Hello, mpi world from rank ',i0,' of ',i0,'!')", cpuid+1,ncpus ! Finalize MPI environment. call MPI_FINALIZE(ierror) From c3bc23c8833120fbf75c441253192652687db350 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 20 Apr 2023 08:37:24 -0500 Subject: [PATCH 048/304] allow implicit typing in example package --- example_packages/metapackage_mpi/fpm.toml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/example_packages/metapackage_mpi/fpm.toml b/example_packages/metapackage_mpi/fpm.toml index 9deea93520..933e9568cc 100644 --- a/example_packages/metapackage_mpi/fpm.toml +++ b/example_packages/metapackage_mpi/fpm.toml @@ -5,6 +5,10 @@ author = "Federico Perini" maintainer = "federico.perini@hello.world" copyright = "Copyright 2023, Federico Perini and the fpm maintainers" +[fortran] +implicit-external = true +implicit-typing = true + [build] auto-executables = true From 9eaf1c807857bff5a455f9157fff7ab4b4c1f19b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 20 Apr 2023 08:49:45 -0500 Subject: [PATCH 049/304] split in MSYS2 / non-MSYS2 cases --- example_packages/metapackage_mpi/app/main.f90 | 2 + src/fpm_meta.f90 | 236 +++++++++++++++--- 2 files changed, 203 insertions(+), 35 deletions(-) diff --git a/example_packages/metapackage_mpi/app/main.f90 b/example_packages/metapackage_mpi/app/main.f90 index c8569f4ed3..8119ac21da 100644 --- a/example_packages/metapackage_mpi/app/main.f90 +++ b/example_packages/metapackage_mpi/app/main.f90 @@ -1,4 +1,5 @@ program with_mpi + implicit none include 'mpif.h' @@ -6,6 +7,7 @@ program with_mpi integer, parameter :: RANK_ERROR = 2 integer :: ierror,ncpus,cpuid + ! Initialize MPI argument call MPI_INIT(ierror); diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 11d493a65a..2c69a2add0 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -21,7 +21,7 @@ module fpm_meta use fpm_git, only : git_target_branch use fpm_manifest, only: package_config_t use fpm_environment, only: get_env,os_is_unix -use fpm_filesystem, only: run, get_temp_filename, getline, exists +use fpm_filesystem, only: run, get_temp_filename, getline, exists, canon_path, is_dir use fpm_versioning, only: version_t, new_version use fpm_os, only: get_absolute_path use iso_fortran_env, only: stdout => output_unit @@ -51,6 +51,9 @@ module fpm_meta type(string_t), allocatable :: incl_dirs(:) type(string_t), allocatable :: link_libs(:) + !> Special fortran features + type(fortran_features_t), allocatable :: fortran + !> List of Development dependency meta data. !> Metapackage dependencies are never exported from the model type(dependency_config_t), allocatable :: dependency(:) @@ -96,6 +99,7 @@ elemental subroutine destroy(this) this%has_include_dirs = .false. this%has_dependencies = .false. + if (allocated(this%fortran)) deallocate(this%fortran) if (allocated(this%version)) deallocate(this%version) if (allocated(this%flags%s)) deallocate(this%flags%s) if (allocated(this%link_flags%s)) deallocate(this%link_flags%s) @@ -234,7 +238,7 @@ subroutine resolve_model(self,model,error) model%include_dirs = [model%include_dirs,self%incl_dirs] end if - ! Dependencies are resolved in the package config + end subroutine resolve_model @@ -243,16 +247,48 @@ subroutine resolve_package_config(self,package,error) type(package_config_t), intent(inout) :: package type(error_t), allocatable, intent(out) :: error - ! All metapackage dependencies are added as full dependencies, - ! as upstream projects will not otherwise compile without them + ! All metapackage dependencies are added as dev-dependencies, + ! as they may change if built upstream if (self%has_dependencies) then - if (allocated(package%dependency)) then - package%dependency = [package%dependency,self%dependency] + if (allocated(package%dev_dependency)) then + package%dev_dependency = [package%dev_dependency,self%dependency] else - package%dependency = self%dependency + package%dev_dependency = self%dependency + end if + end if + + ! Check if there are any special fortran requests which the package does not comply to + if (allocated(self%fortran)) then + + if (self%fortran%implicit_external.neqv.package%fortran%implicit_external) then + call fatal_error(error,'metapackage fortran error: metapackage '// & + dn(self%fortran%implicit_external)//' require implicit-external, main package '//& + dn(package%fortran%implicit_external)) + return + end if + + if (self%fortran%implicit_typing.neqv.package%fortran%implicit_typing) then + call fatal_error(error,'metapackage fortran error: metapackage '// & + dn(self%fortran%implicit_external)//' require implicit-typing, main package '//& + dn(package%fortran%implicit_external)) + return end if + end if + contains + + pure function dn(bool) + logical, intent(in) :: bool + character(len=:), allocatable :: dn + if (bool) then + dn = "does" + else + dn = "does not" + end if + end function dn + + end subroutine resolve_package_config ! Add named metapackage dependency to the model @@ -290,6 +326,14 @@ subroutine add_metapackage_config(package,compiler,name,error) call meta%resolve(package,error) if (allocated(error)) return + ! Temporary + if (name=="mpi") then + + + + + end if + end subroutine add_metapackage_config !> Resolve all metapackages into the package config @@ -329,9 +373,6 @@ subroutine resolve_metapackage_model(model,package,error) ! MPI if (package%meta%mpi) then - - print *, 'resolving MPI...' - call add_metapackage_model(model,"mpi",error) if (allocated(error)) return call add_metapackage_config(package,model%compiler,"mpi",error) @@ -429,15 +470,25 @@ logical function msmpi_init(this,compiler,error) result(found) type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: incdir,libdir,post,reall + character(len=:), allocatable :: incdir,libdir,post,reall,msysdir type(version_t) :: ver,ver10 + type(string_t) :: path + logical :: msys2 !> Default: not found found = .false. if (get_os_type()==OS_WINDOWS) then - !> Find include and library directories + ! to run MSMPI on Windows, + is_minGW: if (compiler%id==id_gcc) then + + call compiler_get_version(compiler,ver,msys2,error) + if (allocated(error)) return + + endif is_minGW + + !> Find include and library directories of the MS-MPI SDK incdir = get_env('MSMPI_INC') if (is_64bit_environment()) then libdir = get_env('MSMPI_LIB64') @@ -454,27 +505,12 @@ logical function msmpi_init(this,compiler,error) result(found) if (len_trim(incdir)<=0 .or. len_trim(libdir)<=0) return if (.not.exists(incdir) .or. .not.exists(libdir)) return - ! Init ms-mpi - call destroy(this) - - this%has_link_flags = .true. - this%link_flags = string_t(' -l'//get_dos_path(join_path(libdir,'msmpi'),error)// & - ' -l'//get_dos_path(join_path(libdir,'msmpifec'),error)) ! fortran-only - if (allocated(error)) return - - this%has_include_dirs = .true. - this%incl_dirs = [string_t(get_dos_path(incdir,error)), & - string_t(get_dos_path(incdir//post,error))] - if (allocated(error)) return - + ! Success! found = .true. ! gfortran>=10 is incompatible with the old-style mpif.h MS-MPI headers. ! If so, add flags to allow old-style BOZ constants in mpif.h - allow_BOZ: if (compiler%id==id_gcc) then - ver = compiler_get_version(compiler,error) - if (allocated(error)) return call new_version(ver10,'10.0.0',error) if (allocated(error)) return @@ -482,11 +518,64 @@ logical function msmpi_init(this,compiler,error) result(found) if (ver>=ver10) then this%has_build_flags = .true. this%flags = string_t(' -fallow-invalid-boz') - end if endif allow_BOZ + ! Init ms-mpi + call destroy(this) + + ! MSYS2 provides a pre-built static msmpi.dll.a library. Use that if possible + use_prebuilt: if (msys2) then + + call compiler_get_path(compiler,path,error) + if (allocated(error)) return + + print *, 'compiler path: '//path%s + stop + + ! Add dir path + this%has_link_flags = .true. + !this%link_flags = string_t(' -L'//get_dos_path(libdir,error)) + this%link_flags = string_t(' -LC:\msys64\mingw64\lib') + + this%has_link_libraries = .true. + this%link_libs = [string_t('msmpi.dll')] + !this%link_libs = [string_t('msmpi'),string_t('msmpifec'),string_t('msmpifmc')] + + if (allocated(error)) return + + this%has_include_dirs = .true. + this%incl_dirs = [string_t(get_dos_path(incdir,error)), & + string_t(get_dos_path(incdir//post,error))] + if (allocated(error)) return + + else + + call fatal_error(error,'MS-MPI cannot work with non-MSYS2 GNU compilers yet') + return + + ! Add dir path + this%has_link_flags = .true. + this%link_flags = string_t(' -L'//get_dos_path(libdir,error)) + + this%has_link_libraries = .true. + this%link_libs = [string_t('msmpi'),string_t('msmpifec'),string_t('msmpifmc')] + + if (allocated(error)) return + + this%has_include_dirs = .true. + this%incl_dirs = [string_t(get_dos_path(incdir,error)), & + string_t(get_dos_path(incdir//post,error))] + if (allocated(error)) return + + + end if use_prebuilt + + !> Request no Fortran implicit typing + allocate(this%fortran) + this%fortran%implicit_typing = .true. + this%fortran%implicit_external = .true. else @@ -499,14 +588,90 @@ logical function msmpi_init(this,compiler,error) result(found) end function msmpi_init +!> Return compiler path +subroutine compiler_get_path(self,path,error) + type(compiler_t), intent(in) :: self + type(string_t), intent(out) :: path + type(error_t), allocatable, intent(out) :: error + + character(:), allocatable :: tmp_file,screen_output,line,fullpath + integer :: stat,iunit,ire,length + + tmp_file = get_temp_filename() + + if (get_os_type()==OS_WINDOWS) then + call run("where "//self%fc, echo=self%echo, verbose=self%verbose, redirect=tmp_file, exitstat=stat) + else + call run("which "//self%fc, echo=self%echo, verbose=self%verbose, redirect=tmp_file, exitstat=stat) + end if + if (stat/=0) then + call fatal_error(error,'compiler_get_path failed for '//self%fc) + return + end if + + ! Only read first instance (first line) + allocate(character(len=0) :: screen_output) + open(newunit=iunit,file=tmp_file,status='old',iostat=stat) + if (stat == 0)then + do + call getline(iunit, line, stat) + if (stat /= 0) exit + if (len(screen_output)>0) then + screen_output = screen_output//new_line('a')//line + else + screen_output = line + endif + end do + ! Close and delete file + close(iunit,status='delete') + else + call fatal_error(error,'cannot read temporary file from successful compiler_get_path') + return + endif + + ! Only use the first instance + length = index(screen_output,new_line('a')) + multiline: if (length>1) then + fullpath = screen_output(1:length-1) + else + fullpath = screen_output + endif multiline + if (len_trim(fullpath)<1) then + call fatal_error(error,'no paths found to the current compiler ('//self%fc//')') + return + end if + + ! Extract path only + length = index(fullpath,self%fc,BACK=.true.) + if (length<=0) then + call fatal_error(error,'full path to the current compiler ('//self%fc//') does not include compiler name') + return + elseif (length==1) then + ! Compiler is in the current folder + call get_absolute_path('.',path%s,error) + else + path%s = canon_path(fullpath(1:length-1)) + end if + + if (.not.is_dir(path%s)) then + call fatal_error(error,'full path to the current compiler ('//self%fc//') is not a directory') + return + end if + +end subroutine compiler_get_path + !> Return compiler version -type(version_t) function compiler_get_version(self,error) +subroutine compiler_get_version(self,version,is_msys2,error) type(compiler_t), intent(in) :: self + type(version_t), intent(out) :: version + logical, intent(out) :: is_msys2 type(error_t), allocatable, intent(out) :: error character(:), allocatable :: tmp_file,screen_output,line integer :: stat,iunit,ire,length + is_msys2 = .false. + select case (self%id) case (id_gcc) @@ -521,21 +686,21 @@ type(version_t) function compiler_get_version(self,error) allocate(character(len=0) :: screen_output) open(newunit=iunit,file=tmp_file,status='old',iostat=stat) if (stat == 0)then - do call getline(iunit, line, stat) if (stat /= 0) exit screen_output = screen_output//' '//line//' ' end do - ! Close and delete file close(iunit,status='delete') - else call fatal_error(error,'cannot read temporary file from successful compiler_get_version') return endif + ! Check if this gcc is from the MSYS2 project + is_msys2 = index(screen_output,'MSYS2')>0 + ! Extract version ire = regex(screen_output,'\d+.\d+.\d+',length=length) @@ -548,14 +713,15 @@ type(version_t) function compiler_get_version(self,error) end if ! Wrap to object - call new_version(compiler_get_version,screen_output,error) + call new_version(version,screen_output,error) + case default call fatal_error(error,'compiler_get_version not yet implemented for compiler '//self%fc) return end select -end function compiler_get_version +end subroutine compiler_get_version !> Ensure a windows path is converted to a DOS path if it contains spaces function get_dos_path(path,error) From 4ce83a759909bedbdaaa6b46daa451c9b75dc42d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 20 Apr 2023 11:40:14 -0500 Subject: [PATCH 050/304] MS-MPI build via MSYS2 completed --- src/fpm_meta.f90 | 96 +++++++++++++++++++++++++++++++----------------- 1 file changed, 63 insertions(+), 33 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 2c69a2add0..19e1c756df 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -470,9 +470,9 @@ logical function msmpi_init(this,compiler,error) result(found) type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: incdir,libdir,post,reall,msysdir + character(len=:), allocatable :: incdir,windir,libdir,post,reall,msysdir type(version_t) :: ver,ver10 - type(string_t) :: path + type(string_t) :: cpath,msys_path logical :: msys2 !> Default: not found @@ -488,66 +488,76 @@ logical function msmpi_init(this,compiler,error) result(found) endif is_minGW - !> Find include and library directories of the MS-MPI SDK - incdir = get_env('MSMPI_INC') + ! Check we're on a 64-bit environment if (is_64bit_environment()) then libdir = get_env('MSMPI_LIB64') post = 'x64' else libdir = get_env('MSMPI_LIB32') post = 'x86' + + !> Not working on 32-bit Windows yet + call fatal_error(error,'MS-MPI error: this package requires 64-bit Windows environment') + return + end if - if (verbose) print 1, 'include',incdir,exists(incdir) - if (verbose) print 1, 'library',libdir,exists(libdir) + ! Check that the runtime is installed + windir = get_env('WINDIR') + call get_absolute_path(join_path(windir,'system32\msmpi.dll'),libdir,error) + if (allocated(error)) return - ! Both directories need be defined and existent - if (len_trim(incdir)<=0 .or. len_trim(libdir)<=0) return - if (.not.exists(incdir) .or. .not.exists(libdir)) return + if (len_trim(libdir)<=0 .or. .not.exists(libdir)) then + call fatal_error(error,'MS-MPI error: msmpi.dll is missing. Is MS-MPI installed on this system?') + return + end if ! Success! found = .true. - ! gfortran>=10 is incompatible with the old-style mpif.h MS-MPI headers. - ! If so, add flags to allow old-style BOZ constants in mpif.h - allow_BOZ: if (compiler%id==id_gcc) then + ! Init ms-mpi + call destroy(this) - call new_version(ver10,'10.0.0',error) + ! MSYS2 provides a pre-built static msmpi.dll.a library. Use that if possible + use_prebuilt: if (msys2) then + + ! MSYS executables are in %MSYS_ROOT%/bin + call compiler_get_path(compiler,cpath,error) if (allocated(error)) return - if (ver>=ver10) then - this%has_build_flags = .true. - this%flags = string_t(' -fallow-invalid-boz') - end if + call get_absolute_path(join_path(cpath%s,'..'),msys_path%s,error) + if (allocated(error)) return - endif allow_BOZ + call get_absolute_path(join_path(msys_path%s,'include'),incdir,error) + if (allocated(error)) return - ! Init ms-mpi - call destroy(this) + call get_absolute_path(join_path(msys_path%s,'lib'),libdir,error) + if (allocated(error)) return - ! MSYS2 provides a pre-built static msmpi.dll.a library. Use that if possible - use_prebuilt: if (msys2) then + if (verbose) print 1, 'include',incdir,exists(incdir) + if (verbose) print 1, 'library',libdir,exists(libdir) - call compiler_get_path(compiler,path,error) + ! Check that the necessary files exist + call get_absolute_path(join_path(libdir,'libmsmpi.dll.a'),post,error) if (allocated(error)) return - print *, 'compiler path: '//path%s - stop + if (len_trim(post)<=0 .or. .not.exists(post)) then + call fatal_error(error,'MS-MPI available through the MSYS2 system not found. '// & + 'Run or your system-specific version to install.') + return + end if - ! Add dir path + ! Add dir cpath this%has_link_flags = .true. - !this%link_flags = string_t(' -L'//get_dos_path(libdir,error)) - this%link_flags = string_t(' -LC:\msys64\mingw64\lib') + this%link_flags = string_t(' -L'//get_dos_path(libdir,error)) this%has_link_libraries = .true. this%link_libs = [string_t('msmpi.dll')] - !this%link_libs = [string_t('msmpi'),string_t('msmpifec'),string_t('msmpifmc')] if (allocated(error)) return this%has_include_dirs = .true. - this%incl_dirs = [string_t(get_dos_path(incdir,error)), & - string_t(get_dos_path(incdir//post,error))] + this%incl_dirs = [string_t(get_dos_path(incdir,error))] if (allocated(error)) return else @@ -577,6 +587,20 @@ logical function msmpi_init(this,compiler,error) result(found) this%fortran%implicit_typing = .true. this%fortran%implicit_external = .true. + ! gfortran>=10 is incompatible with the old-style mpif.h MS-MPI headers. + ! If so, add flags to allow old-style BOZ constants in mpif.h + allow_BOZ: if (compiler%id==id_gcc) then + + call new_version(ver10,'10.0.0',error) + if (allocated(error)) return + + if (ver>=ver10) then + this%has_build_flags = .true. + this%flags = string_t(' -fallow-invalid-boz') + end if + + endif allow_BOZ + else !> Not on Windows @@ -732,6 +756,12 @@ function get_dos_path(path,error) character(:), allocatable :: redirect,screen_output,line integer :: stat,cmdstat,iunit,last + ! Non-Windows OS + if (get_os_type()/=OS_WINDOWS) then + get_dos_path = path + return + end if + ! Trim path first get_dos_path = trim(path) @@ -770,11 +800,11 @@ function get_dos_path(path,error) end if command_OK + get_dos_path = trim(adjustl(screen_output)) + endif has_spaces !> Ensure there are no trailing slashes - get_dos_path = trim(adjustl(screen_output)) - last = len_trim(get_dos_path) if (last>1 .and. get_dos_path(last:last)=='/' .or. get_dos_path(last:last)=='\') get_dos_path = get_dos_path(1:last-1) From 4f450f8bf52d2c7db5076916e4fbf58308c742f0 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 20 Apr 2023 11:41:35 -0500 Subject: [PATCH 051/304] fix truncated line --- src/fpm_meta.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 19e1c756df..c4be59ac25 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -543,7 +543,8 @@ logical function msmpi_init(this,compiler,error) result(found) if (len_trim(post)<=0 .or. .not.exists(post)) then call fatal_error(error,'MS-MPI available through the MSYS2 system not found. '// & - 'Run or your system-specific version to install.') + 'Run '// & + 'or your system-specific version to install.') return end if From 376e3b839f986e8ebe81e37898fe3ba385b06712 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 20 Apr 2023 11:47:30 -0500 Subject: [PATCH 052/304] Check MS-MPI runtime present; add run command --- src/fpm_meta.f90 | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index c4be59ac25..8b57cb6f1b 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -44,10 +44,12 @@ module fpm_meta logical :: has_build_flags = .false. logical :: has_include_dirs = .false. logical :: has_dependencies = .false. + logical :: has_run_command = .false. !> List of compiler flags and options to be added type(string_t) :: flags type(string_t) :: link_flags + type(string_t) :: run_command type(string_t), allocatable :: incl_dirs(:) type(string_t), allocatable :: link_libs(:) @@ -98,11 +100,13 @@ elemental subroutine destroy(this) this%has_build_flags = .false. this%has_include_dirs = .false. this%has_dependencies = .false. + this%has_run_command = .false. if (allocated(this%fortran)) deallocate(this%fortran) if (allocated(this%version)) deallocate(this%version) if (allocated(this%flags%s)) deallocate(this%flags%s) if (allocated(this%link_flags%s)) deallocate(this%link_flags%s) + if (allocated(this%run_command%s)) deallocate(this%run_command%s) if (allocated(this%link_libs)) deallocate(this%link_libs) if (allocated(this%dependency)) deallocate(this%dependency) if (allocated(this%incl_dirs)) deallocate(this%incl_dirs) @@ -470,7 +474,7 @@ logical function msmpi_init(this,compiler,error) result(found) type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: incdir,windir,libdir,post,reall,msysdir + character(len=:), allocatable :: incdir,windir,libdir,bindir,post,reall,msysdir type(version_t) :: ver,ver10 type(string_t) :: cpath,msys_path logical :: msys2 @@ -507,6 +511,12 @@ logical function msmpi_init(this,compiler,error) result(found) call get_absolute_path(join_path(windir,'system32\msmpi.dll'),libdir,error) if (allocated(error)) return + bindir = get_env('MSMPI_BIN') + if (len_trim(bindir)<=0 .or. .not.exists(bindir)) then + call fatal_error(error,'MS-MPI error: MS-MPI Runtime directory is missing. check environment variable %MSMPI_BIN%.') + return + end if + if (len_trim(libdir)<=0 .or. .not.exists(libdir)) then call fatal_error(error,'MS-MPI error: msmpi.dll is missing. Is MS-MPI installed on this system?') return @@ -602,6 +612,10 @@ logical function msmpi_init(this,compiler,error) result(found) endif allow_BOZ + !> Add default run command + this%has_run_command = .true. + this%run_command = string_t(get_dos_path(bindir,error)//' np * ') + else !> Not on Windows From b95c9f467877e85eaa1b53ecd9a80515ebafcdb7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 20 Apr 2023 11:55:56 -0500 Subject: [PATCH 053/304] add MPI runner to settings%runner --- src/fpm_meta.f90 | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 8b57cb6f1b..5dffe74f81 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -17,6 +17,7 @@ module fpm_meta use fpm_error, only: error_t, fatal_error, syntax_error, fpm_stop use fpm_compiler use fpm_model +use fpm_command_line use fpm_manifest_dependency, only: dependency_config_t use fpm_git, only : git_target_branch use fpm_manifest, only: package_config_t @@ -69,9 +70,10 @@ module fpm_meta procedure :: new => init_from_name !> Add metapackage dependencies to the model + procedure, private :: resolve_cmd procedure, private :: resolve_model procedure, private :: resolve_package_config - generic :: resolve => resolve_model,resolve_package_config + generic :: resolve => resolve_cmd,resolve_model,resolve_package_config end type metapackage_t @@ -217,6 +219,30 @@ subroutine init_stdlib(this,compiler,error) end subroutine init_stdlib +! Resolve metapackage dependencies into the command line settings +subroutine resolve_cmd(self,settings,error) + class(metapackage_t), intent(in) :: self + class(fpm_cmd_settings), intent(inout) :: settings + type(error_t), allocatable, intent(out) :: error + + ! Add customize run commands + if (self%has_run_command) then + + select type (cmd=>settings) + class is (fpm_run_settings) ! includes fpm_test_settings + + if (.not.allocated(cmd%runner)) then + cmd%runner = self%run_command%s + else + cmd%runner = self%run_command%s//' '//cmd%runner + end if + + end select + + endif + +end subroutine resolve_cmd + ! Resolve metapackage dependencies into the model subroutine resolve_model(self,model,error) class(metapackage_t), intent(in) :: self From b0ca7f87d01fe18ac2f3dd57719b4124c754a759 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 20 Apr 2023 12:06:16 -0500 Subject: [PATCH 054/304] add runner wrapper for `mpiexec -np *`: works! --- src/fpm.f90 | 10 ++++---- src/fpm/cmd/install.f90 | 4 ++-- src/fpm_meta.f90 | 52 ++++++++++++----------------------------- 3 files changed, 22 insertions(+), 44 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index e23aa3fcdb..07666fb2f9 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -36,7 +36,7 @@ module fpm !> Constructs a valid fpm model from command line settings and the toml manifest. subroutine build_model(model, settings, package, error) type(fpm_model_t), intent(out) :: model - type(fpm_build_settings), intent(in) :: settings + class(fpm_build_settings), intent(inout) :: settings type(package_config_t), intent(inout) :: package type(error_t), allocatable, intent(out) :: error @@ -72,7 +72,7 @@ subroutine build_model(model, settings, package, error) model%module_prefix = package%build%module_prefix ! Resolve meta-dependencies into the package and the model - call resolve_metapackages(model,package,error) + call resolve_metapackages(model,package,settings,error) if (allocated(error)) return ! Create dependencies @@ -415,7 +415,7 @@ subroutine check_module_names(model, error) end subroutine check_module_names subroutine cmd_build(settings) -type(fpm_build_settings), intent(in) :: settings +type(fpm_build_settings), intent(inout) :: settings type(package_config_t) :: package type(fpm_model_t) :: model @@ -452,7 +452,7 @@ subroutine cmd_build(settings) end subroutine cmd_build subroutine cmd_run(settings,test) - class(fpm_run_settings), intent(in) :: settings + class(fpm_run_settings), intent(inout) :: settings logical, intent(in) :: test integer :: i, j, col_width @@ -475,7 +475,7 @@ subroutine cmd_run(settings,test) call fpm_stop(1, '*cmd_run* Package error: '//error%message) end if - call build_model(model, settings%fpm_build_settings, package, error) + call build_model(model, settings, package, error) if (allocated(error)) then call fpm_stop(1, '*cmd_run* Model error: '//error%message) end if diff --git a/src/fpm/cmd/install.f90 b/src/fpm/cmd/install.f90 index c260bfc4df..69375a88be 100644 --- a/src/fpm/cmd/install.f90 +++ b/src/fpm/cmd/install.f90 @@ -22,7 +22,7 @@ module fpm_cmd_install !> Entry point for the fpm-install subcommand subroutine cmd_install(settings) !> Representation of the command line settings - type(fpm_install_settings), intent(in) :: settings + type(fpm_install_settings), intent(inout) :: settings type(package_config_t) :: package type(error_t), allocatable :: error type(fpm_model_t) :: model @@ -34,7 +34,7 @@ subroutine cmd_install(settings) call get_package_data(package, "fpm.toml", error, apply_defaults=.true.) call handle_error(error) - call build_model(model, settings%fpm_build_settings, package, error) + call build_model(model, settings, package, error) call handle_error(error) call targets_from_sources(targets, model, settings%prune, error) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 5dffe74f81..6e6bf81b77 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -322,8 +322,10 @@ end function dn end subroutine resolve_package_config ! Add named metapackage dependency to the model -subroutine add_metapackage_model(model,name,error) +subroutine add_metapackage_model(model,package,settings,name,error) type(fpm_model_t), intent(inout) :: model + type(package_config_t), intent(inout) :: package + class(fpm_cmd_settings), intent(inout) :: settings character(*), intent(in) :: name type(error_t), allocatable, intent(out) :: error @@ -333,43 +335,25 @@ subroutine add_metapackage_model(model,name,error) call meta%new(name,model%compiler,error) if (allocated(error)) return - !> Add it to the model + !> Add it into the model call meta%resolve(model,error) if (allocated(error)) return -end subroutine add_metapackage_model - -! Add named metapackage dependency to the model -subroutine add_metapackage_config(package,compiler,name,error) - type(package_config_t), intent(inout) :: package - type(compiler_t), intent(in) :: compiler - character(*), intent(in) :: name - type(error_t), allocatable, intent(out) :: error - - type(metapackage_t) :: meta - - !> Init metapackage - call meta%new(name,compiler,error) - if (allocated(error)) return - - !> Add it to the model + !> Add it into the package call meta%resolve(package,error) if (allocated(error)) return - ! Temporary - if (name=="mpi") then - - - - - end if + !> Add it into the settings + call meta%resolve(settings,error) + if (allocated(error)) return -end subroutine add_metapackage_config +end subroutine add_metapackage_model !> Resolve all metapackages into the package config -subroutine resolve_metapackage_model(model,package,error) +subroutine resolve_metapackage_model(model,package,settings,error) type(fpm_model_t), intent(inout) :: model type(package_config_t), intent(inout) :: package + class(fpm_build_settings), intent(inout) :: settings type(error_t), allocatable, intent(out) :: error ! Dependencies are added to the package config, so they're properly resolved @@ -382,17 +366,13 @@ subroutine resolve_metapackage_model(model,package,error) ! OpenMP if (package%meta%openmp) then - call add_metapackage_model(model,"openmp",error) - if (allocated(error)) return - call add_metapackage_config(package,model%compiler,"openmp",error) + call add_metapackage_model(model,package,settings,"openmp",error) if (allocated(error)) return endif ! stdlib if (package%meta%stdlib) then - call add_metapackage_model(model,"stdlib",error) - if (allocated(error)) return - call add_metapackage_config(package,model%compiler,"stdlib",error) + call add_metapackage_model(model,package,settings,"stdlib",error) if (allocated(error)) return endif @@ -403,9 +383,7 @@ subroutine resolve_metapackage_model(model,package,error) ! MPI if (package%meta%mpi) then - call add_metapackage_model(model,"mpi",error) - if (allocated(error)) return - call add_metapackage_config(package,model%compiler,"mpi",error) + call add_metapackage_model(model,package,settings,"mpi",error) if (allocated(error)) return endif @@ -640,7 +618,7 @@ logical function msmpi_init(this,compiler,error) result(found) !> Add default run command this%has_run_command = .true. - this%run_command = string_t(get_dos_path(bindir,error)//' np * ') + this%run_command = string_t(join_path(get_dos_path(bindir,error),'mpiexec')//' -np * ') else From a40bda0682e5362e6c615f6fb7efb108fe4640f1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 08:52:11 +0200 Subject: [PATCH 055/304] fix openmpi compiler wrapper --- src/fpm_meta.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 6e6bf81b77..b3c4af16d7 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -400,8 +400,8 @@ subroutine init_mpi(this,compiler,error) type(string_t) :: output character(256) :: msg_out character(len=:), allocatable :: tokens(:) - integer :: mpif90,ic,icpp,i - logical :: wcfit,found + integer :: wcfit,ic,icpp,i + logical :: found !> Cleanup @@ -413,7 +413,7 @@ subroutine init_mpi(this,compiler,error) wcfit = wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,error) - if (allocated(error) .or. .not.wcfit) then + if (allocated(error) .or. wcfit==0) then !> No wrapper compiler fit. Are we on Windows? use MSMPI-specific search found = msmpi_init(this,compiler,error) @@ -428,7 +428,7 @@ subroutine init_mpi(this,compiler,error) else !> Initialize MPI package from wrapper command - call init_mpi_from_wrapper(this,compiler,fort_wrappers(mpif90),error) + call init_mpi_from_wrapper(this,compiler,fort_wrappers(wcfit),error) if (allocated(error)) return end if @@ -446,7 +446,7 @@ logical function is_64bit_environment() end function is_64bit_environment !> Check if there is a wrapper-compiler fit -logical function wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,error) +integer function wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,error) type(string_t), allocatable, intent(in) :: fort_wrappers(:),c_wrappers(:),cpp_wrappers(:) type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error @@ -454,7 +454,7 @@ logical function wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,comp logical :: has_wrappers integer :: mpif90 - wrapper_compiler_fit = .false. + wrapper_compiler_fit = 0 !> Were any wrappers found? has_wrappers = size(fort_wrappers)*size(c_wrappers)*size(cpp_wrappers)>0 @@ -466,7 +466,7 @@ logical function wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,comp if (allocated(error)) return !> Was a valid wrapper found? - wrapper_compiler_fit = mpif90>0 + wrapper_compiler_fit = mpif90 endif From e5ceb064a3c0aeb3a2024dab73f338b2387aff9f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 08:55:03 +0200 Subject: [PATCH 056/304] update regex dependency --- fpm.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm.toml b/fpm.toml index 6e607b3b43..c4a7e4fbbd 100644 --- a/fpm.toml +++ b/fpm.toml @@ -15,7 +15,7 @@ toml-f.rev = "54686e45993f3a9a1d05d5c7419f39e7d5a4eb3f" M_CLI2.git = "https://github.com/urbanjost/M_CLI2.git" M_CLI2.rev = "7264878cdb1baff7323cc48596d829ccfe7751b8" fortran-regex.git = "https://github.com/perazz/fortran-regex" -fortran-regex.tag = "1.1.0" +fortran-regex.tag = "1.1.1" jonquil.git = "https://github.com/toml-f/jonquil" jonquil.rev = "05d30818bb12fb877226ce284b9a3a41b971a889" From 7dc2b945b43afb41db7c63d086cbcb5eb8103b58 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 09:30:02 +0200 Subject: [PATCH 057/304] implement OpenMPI runner command --- src/fpm_meta.f90 | 108 +++++++++++++++++++++++++++++++++++++---------- 1 file changed, 85 insertions(+), 23 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index b3c4af16d7..e30a93688b 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -631,24 +631,30 @@ logical function msmpi_init(this,compiler,error) result(found) end function msmpi_init -!> Return compiler path -subroutine compiler_get_path(self,path,error) - type(compiler_t), intent(in) :: self - type(string_t), intent(out) :: path +!> Find the location of a valid command +subroutine find_command_location(command,path,echo,verbose,error) + character(*), intent(in) :: command + character(len=:), allocatable, intent(out) :: path + logical, optional, intent(in) :: echo,verbose type(error_t), allocatable, intent(out) :: error character(:), allocatable :: tmp_file,screen_output,line,fullpath integer :: stat,iunit,ire,length + if (len_trim(command)<=0) then + call fatal_error(error,'empty command provided in find_command_location') + return + end if + tmp_file = get_temp_filename() if (get_os_type()==OS_WINDOWS) then - call run("where "//self%fc, echo=self%echo, verbose=self%verbose, redirect=tmp_file, exitstat=stat) + call run("where "//command, echo=echo, verbose=verbose, redirect=tmp_file, exitstat=stat) else - call run("which "//self%fc, echo=self%echo, verbose=self%verbose, redirect=tmp_file, exitstat=stat) + call run("which "//command, echo=echo, verbose=verbose, redirect=tmp_file, exitstat=stat) end if if (stat/=0) then - call fatal_error(error,'compiler_get_path failed for '//self%fc) + call fatal_error(error,'compiler_get_path failed for '//command) return end if @@ -668,7 +674,7 @@ subroutine compiler_get_path(self,path,error) ! Close and delete file close(iunit,status='delete') else - call fatal_error(error,'cannot read temporary file from successful compiler_get_path') + call fatal_error(error,'cannot read temporary file from successful find_command_location') return endif @@ -680,27 +686,66 @@ subroutine compiler_get_path(self,path,error) fullpath = screen_output endif multiline if (len_trim(fullpath)<1) then - call fatal_error(error,'no paths found to the current compiler ('//self%fc//')') + call fatal_error(error,'no paths found to command ('//command//')') return end if ! Extract path only - length = index(fullpath,self%fc,BACK=.true.) + length = index(fullpath,command,BACK=.true.) if (length<=0) then - call fatal_error(error,'full path to the current compiler ('//self%fc//') does not include compiler name') + call fatal_error(error,'full path to command ('//command//') does not include command name') return elseif (length==1) then ! Compiler is in the current folder - call get_absolute_path('.',path%s,error) + call get_absolute_path('.',path,error) else - path%s = canon_path(fullpath(1:length-1)) + path = canon_path(fullpath(1:length-1)) end if - if (.not.is_dir(path%s)) then - call fatal_error(error,'full path to the current compiler ('//self%fc//') is not a directory') + if (.not.is_dir(path)) then + call fatal_error(error,'full path to command ('//command//') is not a directory') return end if +end subroutine find_command_location + +!> Get MPI runner in $PATH +subroutine get_mpi_runner(command,verbose,error) + type(string_t), intent(out) :: command + logical, optional, intent(in) :: verbose + type(error_t), allocatable, intent(out) :: error + + character(*), parameter :: try(*) = ['mpiexec','mpirun '] + integer :: itri + logical :: success + + ! Try several commands + do itri=1,size(try) + call find_command_location(trim(try(itri)),command%s,verbose=verbose,error=error) + + ! Success! + success = len_trim(command%s)>0 .and. .not.allocated(error) + if (success) then + command%s = join_path(command%s,trim(try(itri))) + return + endif + + end do + + ! No valid command found + call fatal_error(error,'cannot find a valid mpi runner command') + return + +end subroutine get_mpi_runner + +!> Return compiler path +subroutine compiler_get_path(self,path,error) + type(compiler_t), intent(in) :: self + type(string_t), intent(out) :: path + type(error_t), allocatable, intent(out) :: error + + call find_command_location(self%fc,path%s,self%echo,self%verbose,error) + end subroutine compiler_get_path !> Return compiler version @@ -865,6 +910,12 @@ subroutine init_mpi_from_wrapper(this,compiler,fort_wrapper,error) allocate(this%version,source=version) end if + !> Add default run command, if present + this%run_command = mpi_wrapper_query(fort_wrapper,'runner',verbose,error) + if (allocated(error)) return + this%has_run_command = len_trim(this%run_command)>0 + + end subroutine init_mpi_from_wrapper !> Match one of the available compiler wrappers with the current compiler @@ -1012,7 +1063,7 @@ subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_outp if(present(verbose))then echo_local=verbose else - echo_local=.true. + echo_local=.false. end if ! No redirection and non-verbose output @@ -1062,7 +1113,7 @@ subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_outp screen_output%s = screen_output%s//new_line('a')//line - if (verbose) write(*,'(A)') trim(line) + if (echo_local) write(*,'(A)') trim(line) end do ! Close and delete file @@ -1137,7 +1188,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('--showme:command')],verbose=.true., & + call run_mpi_wrapper(wrapper,[string_t('--showme:command')],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) if (stat/=0 .or. .not.success) then @@ -1160,7 +1211,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('--showme:compile')],verbose=.true., & + call run_mpi_wrapper(wrapper,[string_t('--showme:compile')],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) if (stat/=0 .or. .not.success) then @@ -1184,7 +1235,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('--showme:link')],verbose=.true., & + call run_mpi_wrapper(wrapper,[string_t('--showme:link')],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) if (stat/=0 .or. .not.success) then @@ -1208,7 +1259,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('--showme:libdirs')],verbose=.true., & + call run_mpi_wrapper(wrapper,[string_t('--showme:libdirs')],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) if (stat/=0 .or. .not.success) then @@ -1230,7 +1281,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('--showme:incdirs')],verbose=.true., & + call run_mpi_wrapper(wrapper,[string_t('--showme:incdirs')],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) if (stat/=0 .or. .not.success) then @@ -1252,7 +1303,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('--showme:version')],verbose=.true., & + call run_mpi_wrapper(wrapper,[string_t('--showme:version')],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) if (stat/=0 .or. .not.success) then @@ -1283,6 +1334,17 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( end select + ! Get path to the MPI runner command + case ('runner') + + select case (mpi) + case (MPI_TYPE_OPENMPI) + call get_mpi_runner(screen,verbose,error) + case default + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + return + end select + case default; call fatal_error(error,'an invalid MPI wrapper command ('//command//& ') was invoked for wrapper <'//wrapper%s//'>.') From e8576a0537fe38274727630def6c92eb6e3d9c31 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 10:08:57 +0200 Subject: [PATCH 058/304] make flags language-specific (Fortran, C, C++) --- src/fpm_meta.f90 | 105 ++++++++++++++++++++++++++++++++++++----------- 1 file changed, 80 insertions(+), 25 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index e30a93688b..7ac87b91d4 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -43,12 +43,18 @@ module fpm_meta logical :: has_link_libraries = .false. logical :: has_link_flags = .false. logical :: has_build_flags = .false. + logical :: has_fortran_flags = .false. + logical :: has_c_flags = .false. + logical :: has_cxx_flags = .false. logical :: has_include_dirs = .false. logical :: has_dependencies = .false. logical :: has_run_command = .false. !> List of compiler flags and options to be added type(string_t) :: flags + type(string_t) :: fflags + type(string_t) :: cflags + type(string_t) :: cxxflags type(string_t) :: link_flags type(string_t) :: run_command type(string_t), allocatable :: incl_dirs(:) @@ -87,19 +93,27 @@ module fpm_meta integer, parameter :: MPI_TYPE_INTEL = 3 integer, parameter :: MPI_TYPE_MSMPI = 4 + + !> Debugging information logical, parameter, private :: verbose = .true. +integer, parameter, private :: WRAPPER_FORTRAN = 1 +integer, parameter, private :: WRAPPER_C = 2 +integer, parameter, private :: WRAPPER_CXX = 3 + contains !> Clean the metapackage structure elemental subroutine destroy(this) class(metapackage_t), intent(inout) :: this - this%has_link_libraries = .false. this%has_link_flags = .false. this%has_build_flags = .false. + this%has_fortran_flags = .false. + this%has_c_flags = .false. + this%has_cxx_flags = .false. this%has_include_dirs = .false. this%has_dependencies = .false. this%has_run_command = .false. @@ -107,6 +121,9 @@ elemental subroutine destroy(this) if (allocated(this%fortran)) deallocate(this%fortran) if (allocated(this%version)) deallocate(this%version) if (allocated(this%flags%s)) deallocate(this%flags%s) + if (allocated(this%fflags%s)) deallocate(this%fflags%s) + if (allocated(this%cflags%s)) deallocate(this%cflags%s) + if (allocated(this%cxxflags%s)) deallocate(this%cxxflags%s) if (allocated(this%link_flags%s)) deallocate(this%link_flags%s) if (allocated(this%run_command%s)) deallocate(this%run_command%s) if (allocated(this%link_libs)) deallocate(this%link_libs) @@ -249,13 +266,20 @@ subroutine resolve_model(self,model,error) type(fpm_model_t), intent(inout) :: model type(error_t), allocatable, intent(out) :: error - ! For now, additional flags are assumed to apply to all sources + ! Add global build flags, to apply to all sources if (self%has_build_flags) then model%fortran_compile_flags = model%fortran_compile_flags//self%flags%s model%c_compile_flags = model%c_compile_flags//self%flags%s model%cxx_compile_flags = model%cxx_compile_flags//self%flags%s endif + ! Add language-specific flags + print *, 'has fortran,c,cpp',self%has_fortran_flags,self%has_c_flags,self%has_cxx_flags + stop + if (self%has_fortran_flags) model%fortran_compile_flags = model%fortran_compile_flags//self%fflags%s + if (self%has_c_flags) model%c_compile_flags = model%c_compile_flags//self%cflags%s + if (self%has_cxx_flags) model%cxx_compile_flags = model%cxx_compile_flags//self%cxxflags%s + if (self%has_link_flags) then model%link_flags = model%link_flags//self%link_flags%s end if @@ -268,8 +292,6 @@ subroutine resolve_model(self,model,error) model%include_dirs = [model%include_dirs,self%incl_dirs] end if - - end subroutine resolve_model subroutine resolve_package_config(self,package,error) @@ -397,10 +419,10 @@ subroutine init_mpi(this,compiler,error) type(string_t), allocatable :: c_wrappers(:),cpp_wrappers(:),fort_wrappers(:) - type(string_t) :: output + type(string_t) :: output,fwrap,cwrap,cxxwrap character(256) :: msg_out character(len=:), allocatable :: tokens(:) - integer :: wcfit,ic,icpp,i + integer :: wcfit(3),ic,icpp,i logical :: found @@ -413,7 +435,7 @@ subroutine init_mpi(this,compiler,error) wcfit = wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,error) - if (allocated(error) .or. wcfit==0) then + if (allocated(error) .or. all(wcfit==0)) then !> No wrapper compiler fit. Are we on Windows? use MSMPI-specific search found = msmpi_init(this,compiler,error) @@ -427,8 +449,12 @@ subroutine init_mpi(this,compiler,error) else + if (wcfit(WRAPPER_FORTRAN)>0) fwrap = fort_wrappers(wcfit(WRAPPER_FORTRAN)) + if (wcfit(WRAPPER_C)>0) cwrap = c_wrappers (wcfit(WRAPPER_C)) + if (wcfit(WRAPPER_CXX)>0) cxxwrap = cpp_wrappers (wcfit(WRAPPER_CXX)) + !> Initialize MPI package from wrapper command - call init_mpi_from_wrapper(this,compiler,fort_wrappers(wcfit),error) + call init_mpi_from_wrappers(this,compiler,fwrap,cwrap,cxxwrap,error) if (allocated(error)) return end if @@ -446,27 +472,32 @@ logical function is_64bit_environment() end function is_64bit_environment !> Check if there is a wrapper-compiler fit -integer function wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,error) +function wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,error) result(wrap) type(string_t), allocatable, intent(in) :: fort_wrappers(:),c_wrappers(:),cpp_wrappers(:) type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error + integer :: wrap(3) logical :: has_wrappers - integer :: mpif90 + integer :: mpif90,mpic,mpicxx + type(error_t), allocatable :: wrap_error - wrapper_compiler_fit = 0 + wrap = 0 !> Were any wrappers found? has_wrappers = size(fort_wrappers)*size(c_wrappers)*size(cpp_wrappers)>0 if (has_wrappers) then - !> Find an MPI wrapper that matches the current compiler - mpif90 = mpi_compiler_match(fort_wrappers,compiler,error) - if (allocated(error)) return + !> Find a Fortran wrapper for the current compiler + wrap(WRAPPER_FORTRAN) = mpi_compiler_match(fort_wrappers,compiler,wrap_error) + wrap(WRAPPER_C ) = mpi_compiler_match(c_wrappers,compiler,wrap_error) + wrap(WRAPPER_CXX ) = mpi_compiler_match(cpp_wrappers,compiler,wrap_error) - !> Was a valid wrapper found? - wrapper_compiler_fit = mpif90 + if (all(wrap==0)) then + call fatal_error(error,'no valid wrappers match current compiler, '//compiler_name(compiler)) + return + end if endif @@ -875,10 +906,10 @@ function get_dos_path(path,error) end function get_dos_path !> Initialize an MPI metapackage from a valid wrapper command ('mpif90', etc...) -subroutine init_mpi_from_wrapper(this,compiler,fort_wrapper,error) +subroutine init_mpi_from_wrappers(this,compiler,fort_wrapper,c_wrapper,cxx_wrapper,error) class(metapackage_t), intent(inout) :: this type(compiler_t), intent(in) :: compiler - type(string_t), intent(in) :: fort_wrapper + type(string_t), intent(in) :: fort_wrapper,c_wrapper,cxx_wrapper type(error_t), allocatable, intent(out) :: error type(version_t) :: version @@ -894,13 +925,13 @@ subroutine init_mpi_from_wrapper(this,compiler,fort_wrapper,error) ! Add heading space this%link_flags = string_t(' '//this%link_flags%s) - ! Get build flags - this%flags = mpi_wrapper_query(fort_wrapper,'flags',verbose,error) + ! Add language-specific flags + call set_language_flags(fort_wrapper,this%has_fortran_flags,this%fflags,verbose,error) + if (allocated(error)) return + call set_language_flags(c_wrapper,this%has_c_flags,this%cflags,verbose,error) + if (allocated(error)) return + call set_language_flags(cxx_wrapper,this%has_cxx_flags,this%cxxflags,verbose,error) if (allocated(error)) return - this%has_build_flags = len_trim(this%flags)>0 - - ! Add heading space - this%flags = string_t(' '//this%flags%s) ! Get library version version = mpi_version_get(fort_wrapper,error) @@ -915,8 +946,32 @@ subroutine init_mpi_from_wrapper(this,compiler,fort_wrapper,error) if (allocated(error)) return this%has_run_command = len_trim(this%run_command)>0 + contains + + subroutine set_language_flags(wrapper,has_flags,flags,verbose,error) + type(string_t), intent(in) :: wrapper + logical, intent(inout) :: has_flags + type(string_t), intent(inout) :: flags + logical, intent(in) :: verbose + type(error_t), allocatable, intent(out) :: error + + ! Get build flags for each language + if (len_trim(wrapper)>0) then + flags = mpi_wrapper_query(wrapper,'flags',verbose,error) + + print *, 'flags=',flags%s,' error=',allocated(error),' wrapper=',wrapper%s + + if (allocated(error)) return + this%has_fortran_flags = len_trim(flags)>0 + + ! Add heading space + flags = string_t(' '//flags%s) + endif + + end subroutine set_language_flags + -end subroutine init_mpi_from_wrapper +end subroutine init_mpi_from_wrappers !> Match one of the available compiler wrappers with the current compiler integer function mpi_compiler_match(wrappers,compiler,error) From 82d03c5621acc10ebe8b97e839f6f5905aabd70d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 10:14:11 +0200 Subject: [PATCH 059/304] fix: language flags --- src/fpm_meta.f90 | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 7ac87b91d4..fc8ef744c9 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -274,8 +274,6 @@ subroutine resolve_model(self,model,error) endif ! Add language-specific flags - print *, 'has fortran,c,cpp',self%has_fortran_flags,self%has_c_flags,self%has_cxx_flags - stop if (self%has_fortran_flags) model%fortran_compile_flags = model%fortran_compile_flags//self%fflags%s if (self%has_c_flags) model%c_compile_flags = model%c_compile_flags//self%cflags%s if (self%has_cxx_flags) model%cxx_compile_flags = model%cxx_compile_flags//self%cxxflags%s @@ -449,6 +447,8 @@ subroutine init_mpi(this,compiler,error) else + print *, 'wcfit=',wcfit + if (wcfit(WRAPPER_FORTRAN)>0) fwrap = fort_wrappers(wcfit(WRAPPER_FORTRAN)) if (wcfit(WRAPPER_C)>0) cwrap = c_wrappers (wcfit(WRAPPER_C)) if (wcfit(WRAPPER_CXX)>0) cxxwrap = cpp_wrappers (wcfit(WRAPPER_CXX)) @@ -962,7 +962,7 @@ subroutine set_language_flags(wrapper,has_flags,flags,verbose,error) print *, 'flags=',flags%s,' error=',allocated(error),' wrapper=',wrapper%s if (allocated(error)) return - this%has_fortran_flags = len_trim(flags)>0 + has_flags = len_trim(flags)>0 ! Add heading space flags = string_t(' '//flags%s) @@ -984,6 +984,13 @@ integer function mpi_compiler_match(wrappers,compiler,error) character(128) :: msg_out type(compiler_t) :: mpi_compiler + !> If there's only one available wrapper, we're forced to use that one regardless of + !> what compiler it was bound to + if (size(wrappers)==1) then + mpi_compiler_match = 1 + return + end if + mpi_compiler_match = 0 do i=1,size(wrappers) From 7076f9f362475360f0b7487177b6ebe1fdae1dc0 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 10:15:44 +0200 Subject: [PATCH 060/304] improve verbose outout --- src/fpm_meta.f90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index fc8ef744c9..7a623265ef 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -447,8 +447,6 @@ subroutine init_mpi(this,compiler,error) else - print *, 'wcfit=',wcfit - if (wcfit(WRAPPER_FORTRAN)>0) fwrap = fort_wrappers(wcfit(WRAPPER_FORTRAN)) if (wcfit(WRAPPER_C)>0) cwrap = c_wrappers (wcfit(WRAPPER_C)) if (wcfit(WRAPPER_CXX)>0) cxxwrap = cpp_wrappers (wcfit(WRAPPER_CXX)) @@ -959,13 +957,14 @@ subroutine set_language_flags(wrapper,has_flags,flags,verbose,error) if (len_trim(wrapper)>0) then flags = mpi_wrapper_query(wrapper,'flags',verbose,error) - print *, 'flags=',flags%s,' error=',allocated(error),' wrapper=',wrapper%s - if (allocated(error)) return has_flags = len_trim(flags)>0 ! Add heading space flags = string_t(' '//flags%s) + + if (verbose) print *, 'MPI set language flags from wrapper <',wrapper%s,'>: flags=',flags%s + endif end subroutine set_language_flags From 92507c354b2ffdc85ce11b062ff7acc494a02ab7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 10:50:16 +0200 Subject: [PATCH 061/304] identify MPICH wrappers --- src/fpm_meta.f90 | 36 ++++++++++++++++++++---------------- 1 file changed, 20 insertions(+), 16 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 7a623265ef..7e5ecadb80 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -451,6 +451,14 @@ subroutine init_mpi(this,compiler,error) if (wcfit(WRAPPER_C)>0) cwrap = c_wrappers (wcfit(WRAPPER_C)) if (wcfit(WRAPPER_CXX)>0) cxxwrap = cpp_wrappers (wcfit(WRAPPER_CXX)) + !> If there's only an available Fortran wrapper, and the compiler's different than fpm's baseline + !> fortran compiler suite, we still want to enable C language flags as that is most likely being + !> ABI-compatible anyways. However, issues may arise. + !> see e.g. Homebrew with clabng C/C++ and GNU fortran at https://gitlab.kitware.com/cmake/cmake/-/issues/18139 + if (wcfit(WRAPPER_FORTRAN)>0 .and. wcfit(WRAPPER_C)==0 .and. wcfit(WRAPPER_CXX)==0) then + cwrap = fort_wrappers(wcfit(WRAPPER_FORTRAN)) + end if + !> Initialize MPI package from wrapper command call init_mpi_from_wrappers(this,compiler,fwrap,cwrap,cxxwrap,error) if (allocated(error)) return @@ -969,7 +977,6 @@ subroutine set_language_flags(wrapper,has_flags,flags,verbose,error) end subroutine set_language_flags - end subroutine init_mpi_from_wrappers !> Match one of the available compiler wrappers with the current compiler @@ -983,13 +990,6 @@ integer function mpi_compiler_match(wrappers,compiler,error) character(128) :: msg_out type(compiler_t) :: mpi_compiler - !> If there's only one available wrapper, we're forced to use that one regardless of - !> what compiler it was bound to - if (size(wrappers)==1) then - mpi_compiler_match = 1 - return - end if - mpi_compiler_match = 0 do i=1,size(wrappers) @@ -1201,22 +1201,26 @@ integer function which_mpi_library(wrapper,verbose) if (is_mpi_wrapper) then + ! Init as currently unsupported library + which_mpi_library = MPI_TYPE_NONE + ! Attempt to decipher which library this wrapper comes from. ! OpenMPI responds to '--showme' calls call run_mpi_wrapper(wrapper,[string_t('--showme')],verbose,& exitcode=stat,cmd_success=is_mpi_wrapper) - if (stat==0 .and. is_mpi_wrapper) then - which_mpi_library = MPI_TYPE_OPENMPI + return + endif - else - - ! This MPI wrapper is of a currently unsupported library - which_mpi_library = MPI_TYPE_NONE - - end if + ! MPICH responds to '-show' calls + call run_mpi_wrapper(wrapper,[string_t('-show')],verbose,& + exitcode=stat,cmd_success=is_mpi_wrapper) + if (stat==0 .and. is_mpi_wrapper) then + which_mpi_library = MPI_TYPE_MPICH + return + endif else From 01e3a7f80ca48987852a136a32f32c7d97581bf3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 11:32:17 +0200 Subject: [PATCH 062/304] implement MPICH commands --- src/fpm_meta.f90 | 102 +++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 98 insertions(+), 4 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 7e5ecadb80..b4cabf2d6d 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1149,7 +1149,6 @@ subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_outp end do endif add_arguments - if (echo_local) print *, '+ ', command ! Test command @@ -1238,7 +1237,9 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( type(error_t), allocatable, intent(out) :: error logical :: success - character(:), allocatable :: redirect_str + character(:), allocatable :: redirect_str,tokens(:) + type(string_t) :: cmdstr + type(compiler_t) :: mpi_compiler integer :: stat,cmdstat,mpi,ire,length ! Get mpi type @@ -1261,6 +1262,21 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( return end if + case (MPI_TYPE_MPICH) + + ! -compile_info returns the build command of this wrapper + call run_mpi_wrapper(wrapper,[string_t('-compile-info')],verbose=verbose, & + exitcode=stat,cmd_success=success,screen_output=screen) + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local MPICH library does not support -compile-info') + return + end if + + ! Take out the first command from the whole line + call split(screen%s,tokens,delimiters=' ') + screen%s = tokens(1) + case default call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') @@ -1286,6 +1302,26 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( call remove_new_lines(screen) + case (MPI_TYPE_MPICH) + + call run_mpi_wrapper(wrapper,[string_t('-compile-info')],verbose=verbose, & + exitcode=stat,cmd_success=success,screen_output=screen) + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local MPICH library does not support -compile-info') + return + end if + + ! MPICH reports the full command including the compiler name. Remove it if so + call remove_new_lines(screen) + call split(screen%s,tokens) + call new_compiler(mpi_compiler,tokens(1),tokens(1),tokens(1),echo=.false.,verbose=verbose) + + if (mpi_compiler%id/=id_unknown) then + ! Remove trailing compiler name + screen%s = screen%s(len_trim(tokens(1))+1:) + end if + case default call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') @@ -1299,7 +1335,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( select case (mpi) case (MPI_TYPE_OPENMPI) - ! --showme:command returns the build command of this wrapper + ! --showme:link returns the linker command of this wrapper call run_mpi_wrapper(wrapper,[string_t('--showme:link')],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) @@ -1310,6 +1346,26 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( call remove_new_lines(screen) + case (MPI_TYPE_MPICH) + + call run_mpi_wrapper(wrapper,[string_t('-link-info')],verbose=verbose, & + exitcode=stat,cmd_success=success,screen_output=screen) + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local MPICH library does not support -link-info') + return + end if + + ! MPICH reports the full command including the compiler name. Remove it if so + call remove_new_lines(screen) + call split(screen%s,tokens) + call new_compiler(mpi_compiler,tokens(1),tokens(1),tokens(1),echo=.false.,verbose=verbose) + + if (mpi_compiler%id/=id_unknown) then + ! Remove trailing compiler name + screen%s = screen%s(len_trim(tokens(1))+1:) + end if + case default call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') @@ -1392,6 +1448,44 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( end if + case (MPI_TYPE_MPICH) + + !> MPICH offers command "mpichversion" in the same system folder as the MPI wrappers. + !> So, attempt to run that first + cmdstr = string_t('mpichversion') + call run_mpi_wrapper(cmdstr,verbose=verbose, & + exitcode=stat,cmd_success=success,screen_output=screen) + + ! Second option: run mpich wrapper + "-v" + if (stat/=0 .or. .not.success) then + call run_mpi_wrapper(wrapper,[string_t('-v')],verbose=verbose, & + exitcode=stat,cmd_success=success,screen_output=screen) + call remove_new_lines(screen) + endif + + ! Third option: mpiexec --version + if (stat/=0 .or. .not.success) then + cmdstr = string_t('mpiexec --version') + call run_mpi_wrapper(cmdstr,verbose=verbose, & + exitcode=stat,cmd_success=success,screen_output=screen) + endif + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'cannot retrieve MPICH library version from ') + return + else + + ! Extract version + ire = regex(screen%s,'\d+.\d+.\d+',length=length) + if (ire>0 .and. length>0) then + ! Parse version into the object (this should always work) + screen%s = screen%s(ire:ire+length-1) + else + call syntax_error(error,'cannot retrieve MPICH library version.') + end if + + end if + case default call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') @@ -1403,7 +1497,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( case ('runner') select case (mpi) - case (MPI_TYPE_OPENMPI) + case (MPI_TYPE_OPENMPI,MPI_TYPE_MPICH,MPI_TYPE_MSMPI) call get_mpi_runner(screen,verbose,error) case default call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') From c625cf1aca0598b01cb65925783af4bf32224e1b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 11:37:16 +0200 Subject: [PATCH 063/304] pass flags to c++ on mixed compilers --- src/fpm_meta.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index b4cabf2d6d..b64bc28529 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -457,6 +457,7 @@ subroutine init_mpi(this,compiler,error) !> see e.g. Homebrew with clabng C/C++ and GNU fortran at https://gitlab.kitware.com/cmake/cmake/-/issues/18139 if (wcfit(WRAPPER_FORTRAN)>0 .and. wcfit(WRAPPER_C)==0 .and. wcfit(WRAPPER_CXX)==0) then cwrap = fort_wrappers(wcfit(WRAPPER_FORTRAN)) + cxxwrap = fort_wrappers(wcfit(WRAPPER_FORTRAN)) end if !> Initialize MPI package from wrapper command From 079a1979f8157f94b268584b625b02ff0287812a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 11:50:13 +0200 Subject: [PATCH 064/304] create metapackage workflow --- .github/workflows/meta.yml | 172 +++++++++++++++++++ ci/meta_tests.sh | 36 ++++ example_packages/metapackage_stdlib/fpm.toml | 4 - 3 files changed, 208 insertions(+), 4 deletions(-) create mode 100644 .github/workflows/meta.yml create mode 100755 ci/meta_tests.sh diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml new file mode 100644 index 0000000000..01bba6f414 --- /dev/null +++ b/.github/workflows/meta.yml @@ -0,0 +1,172 @@ +name: metapackage-tests + +on: + push: + pull_request: + release: + types: [published] + +env: + CI: "ON" # We can detect this in the build system and other vendors implement it + HOMEBREW_NO_ANALYTICS: "ON" # Make Homebrew installation a little quicker + HOMEBREW_NO_AUTO_UPDATE: "ON" + HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: "ON" + HOMEBREW_NO_GITHUB_API: "ON" + HOMEBREW_NO_INSTALL_CLEANUP: "ON" + +jobs: + + build: + runs-on: ${{ matrix.os }} + strategy: + fail-fast: false + matrix: + os: [macos-11] ##[ubuntu-latest, macos-11, windows-latest] + gcc_v: [10] # Version of GFortran we want to use + include: + - os: ubuntu-latest + os-arch: linux-x86_64 + release-flags: --flag '--static -g -fbacktrace -O3' + + - os: macos-11 + os-arch: macos-x86_64 + release-flags: --flag '-g -fbacktrace -O3' + + - os: windows-latest + os-arch: windows-x86_64 + release-flags: --flag '--static -g -fbacktrace -O3' + exe: .exe + + env: + FC: gfortran + GCC_V: ${{ matrix.gcc_v }} + + steps: + - name: Checkout code + uses: actions/checkout@v1 + + - name: Install GFortran macOS + if: contains(matrix.os, 'macos') + run: | + ln -s /usr/local/bin/gfortran-${GCC_V} /usr/local/bin/gfortran + which gfortran-${GCC_V} + which gfortran + # Backport gfortran shared libraries to version 9 folder. This is necessary because all macOS releases of fpm + # have these paths hardcoded in the executable (no PIC?). As the gcc ABIs have not changed from 9 to 10, we + # can just create symbolic links for now. This can be removed when an updated fpm release is built with gcc-10 + mkdir /usr/local/opt/gcc@9 + mkdir /usr/local/opt/gcc@9/lib + mkdir /usr/local/opt/gcc@9/lib/gcc + mkdir /usr/local/opt/gcc@9/lib/gcc/9 + mkdir /usr/local/lib/gcc/9 + ln -fs /usr/local/opt/gcc@${GCC_V}/lib/gcc/${GCC_V}/libquadmath.0.dylib /usr/local/opt/gcc@9/lib/gcc/9/libquadmath.0.dylib + ln -fs /usr/local/opt/gcc@${GCC_V}/lib/gcc/${GCC_V}/libgfortran.5.dylib /usr/local/opt/gcc@9/lib/gcc/9/libgfortran.5.dylib + ln -fs /usr/local/lib/gcc/${GCC_V}/libgcc_s.1.dylib /usr/local/lib/gcc/9/libgcc_s.1.dylib + + - name: Install GFortran Linux + if: contains(matrix.os, 'ubuntu') + run: | + sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-${GCC_V} 100 \ + --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${GCC_V} \ + --slave /usr/bin/gcov gcov /usr/bin/gcov-${GCC_V} + + - name: Install GFortran Windows + if: contains(matrix.os, 'windows') + run: | + Invoke-WebRequest -Uri $Env:GCC_DOWNLOAD -OutFile mingw-w64.zip + Expand-Archive mingw-w64.zip + echo "$pwd\mingw-w64\mingw64\bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append + env: + GCC_DOWNLOAD: "https://github.com/brechtsanders/winlibs_mingw/releases/download/10.4.0-10.0.0-msvcrt-r1/winlibs-x86_64-posix-seh-gcc-10.4.0-mingw-w64msvcrt-10.0.0-r1.zip" + + # Phase 1: Bootstrap fpm with existing version + - name: Install fpm + uses: fortran-lang/setup-fpm@v3 + with: + fpm-version: 'v0.8.0' + + - name: Remove fpm from path + shell: bash + run: | + mv $(which fpm) fpm-bootstrap${{ matrix.exe }} + echo "BOOTSTRAP=$PWD/fpm-bootstrap" >> $GITHUB_ENV + + - name: Build Fortran fpm (bootstrap) + shell: bash + run: | + ${{ env.BOOTSTRAP }} build + + - name: Run Fortran fpm (bootstrap) + shell: bash + run: | + ${{ env.BOOTSTRAP }} run + ${{ env.BOOTSTRAP }} run -- --version + ${{ env.BOOTSTRAP }} run -- --help + + - name: Test Fortran fpm (bootstrap) + shell: bash + run: | + ${{ env.BOOTSTRAP }} test + + - name: Install Fortran fpm (bootstrap) + shell: bash + run: | + ${{ env.BOOTSTRAP }} install + + # Phase 2: Bootstrap fpm with itself + - name: Replace bootstrapping version + shell: bash + run: | + ${{ env.BOOTSTRAP }} run --runner cp -- fpm-debug${{ matrix.exe }} + rm -v ${{ env.BOOTSTRAP }} + echo "FPM=$PWD/fpm-debug" >> $GITHUB_ENV + + - name: Get version (normal) + if: github.event_name != 'release' + shell: bash + run: | + VERSION=$(git rev-parse --short HEAD) + echo "VERSION=$VERSION" >> $GITHUB_ENV + + - name: Get version (release) + if: github.event_name == 'release' + shell: bash + run: | + VERSION=$(echo ${{ github.ref }} | cut -dv -f2) + echo "VERSION=$VERSION" >> $GITHUB_ENV + FPM_VERSION=$(${{ env.FPM }} --version | grep -o '${{ env.REGEX }}') + [ "$VERSION" = "$FPM_VERSION" ] + env: + REGEX: '[0-9]\{1,4\}\.[0-9]\{1,4\}\.[0-9]\{1,4\}' + + - name: Build Fortran fpm + shell: bash + run: | + ${{ env.FPM }} build ${{ matrix.release-flags }} + + - name: Run Fortran fpm + shell: bash + run: | + ${{ env.FPM }} run ${{ matrix.release-flags }} + ${{ env.FPM }} run ${{ matrix.release-flags }} -- --version + ${{ env.FPM }} run ${{ matrix.release-flags }} -- --help + + - name: Install Fortran fpm + shell: bash + run: | + ${{ env.FPM }} install ${{ matrix.release-flags }} + + - name: Package release version + shell: bash + run: | + ${{ env.FPM }} run ${{ matrix.release-flags }} --runner cp -- ${{ env.EXE }} + rm -v ${{ env.FPM }} + echo "FPM_RELEASE=${{ env.EXE }}" >> $GITHUB_ENV + env: + EXE: fpm-${{ env.VERSION }}-${{ matrix.os-arch }}${{ matrix.exe }} + + - name: Run metapackage tests using the release version + shell: bash + run: | + ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" + diff --git a/ci/meta_tests.sh b/ci/meta_tests.sh new file mode 100755 index 0000000000..16d333b530 --- /dev/null +++ b/ci/meta_tests.sh @@ -0,0 +1,36 @@ +#!/usr/bin/env bash +set -ex + +# *********************** +# This script tests all example packages using any metapackage/system dependencies +# *********************** + +cd "$(dirname $0)/.." + +if [ "$1" ]; then + fpm="$1" +else + fpm=fpm +fi + +# Build example packages +pushd example_packages/ +rm -rf ./*/build + +pushd metapackage_openmp +"$fpm" build +"$fpm" run +popd + +pushd metapackage_stdlib +"$fpm" build +"$fpm" run +popd + +pushd metapackage_mpi +"$fpm" build +"$fpm" run +popd + +# Cleanup +rm -rf ./*/build diff --git a/example_packages/metapackage_stdlib/fpm.toml b/example_packages/metapackage_stdlib/fpm.toml index 66df2f11fb..b90849bd50 100644 --- a/example_packages/metapackage_stdlib/fpm.toml +++ b/example_packages/metapackage_stdlib/fpm.toml @@ -1,9 +1,5 @@ name = "test_stdlib" version = "0.1.0" -license = "license" -author = "Federico Perini" -maintainer = "federico.perini@hello.world" -copyright = "Copyright 2023, Federico Perini and the fpm maintainers" [build] auto-executables = true From f8ee6f81bb13a1ad43b3ea2ec05f782eee59e079 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 11:53:18 +0200 Subject: [PATCH 065/304] remove non-mac tests --- .github/workflows/meta.yml | 25 ------------------------- 1 file changed, 25 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 01bba6f414..8e7eca4d7c 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -24,19 +24,10 @@ jobs: os: [macos-11] ##[ubuntu-latest, macos-11, windows-latest] gcc_v: [10] # Version of GFortran we want to use include: - - os: ubuntu-latest - os-arch: linux-x86_64 - release-flags: --flag '--static -g -fbacktrace -O3' - - os: macos-11 os-arch: macos-x86_64 release-flags: --flag '-g -fbacktrace -O3' - - os: windows-latest - os-arch: windows-x86_64 - release-flags: --flag '--static -g -fbacktrace -O3' - exe: .exe - env: FC: gfortran GCC_V: ${{ matrix.gcc_v }} @@ -63,22 +54,6 @@ jobs: ln -fs /usr/local/opt/gcc@${GCC_V}/lib/gcc/${GCC_V}/libgfortran.5.dylib /usr/local/opt/gcc@9/lib/gcc/9/libgfortran.5.dylib ln -fs /usr/local/lib/gcc/${GCC_V}/libgcc_s.1.dylib /usr/local/lib/gcc/9/libgcc_s.1.dylib - - name: Install GFortran Linux - if: contains(matrix.os, 'ubuntu') - run: | - sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-${GCC_V} 100 \ - --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${GCC_V} \ - --slave /usr/bin/gcov gcov /usr/bin/gcov-${GCC_V} - - - name: Install GFortran Windows - if: contains(matrix.os, 'windows') - run: | - Invoke-WebRequest -Uri $Env:GCC_DOWNLOAD -OutFile mingw-w64.zip - Expand-Archive mingw-w64.zip - echo "$pwd\mingw-w64\mingw64\bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append - env: - GCC_DOWNLOAD: "https://github.com/brechtsanders/winlibs_mingw/releases/download/10.4.0-10.0.0-msvcrt-r1/winlibs-x86_64-posix-seh-gcc-10.4.0-mingw-w64msvcrt-10.0.0-r1.zip" - # Phase 1: Bootstrap fpm with existing version - name: Install fpm uses: fortran-lang/setup-fpm@v3 From 40139bab7e5a2429f82e1170e217d3c2e308c623 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 12:00:32 +0200 Subject: [PATCH 066/304] setup homebrew --- .github/workflows/meta.yml | 22 ++++------------------ 1 file changed, 4 insertions(+), 18 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 8e7eca4d7c..c8f816194b 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -21,7 +21,7 @@ jobs: strategy: fail-fast: false matrix: - os: [macos-11] ##[ubuntu-latest, macos-11, windows-latest] + os: [macos-11] gcc_v: [10] # Version of GFortran we want to use include: - os: macos-11 @@ -36,23 +36,9 @@ jobs: - name: Checkout code uses: actions/checkout@v1 - - name: Install GFortran macOS - if: contains(matrix.os, 'macos') - run: | - ln -s /usr/local/bin/gfortran-${GCC_V} /usr/local/bin/gfortran - which gfortran-${GCC_V} - which gfortran - # Backport gfortran shared libraries to version 9 folder. This is necessary because all macOS releases of fpm - # have these paths hardcoded in the executable (no PIC?). As the gcc ABIs have not changed from 9 to 10, we - # can just create symbolic links for now. This can be removed when an updated fpm release is built with gcc-10 - mkdir /usr/local/opt/gcc@9 - mkdir /usr/local/opt/gcc@9/lib - mkdir /usr/local/opt/gcc@9/lib/gcc - mkdir /usr/local/opt/gcc@9/lib/gcc/9 - mkdir /usr/local/lib/gcc/9 - ln -fs /usr/local/opt/gcc@${GCC_V}/lib/gcc/${GCC_V}/libquadmath.0.dylib /usr/local/opt/gcc@9/lib/gcc/9/libquadmath.0.dylib - ln -fs /usr/local/opt/gcc@${GCC_V}/lib/gcc/${GCC_V}/libgfortran.5.dylib /usr/local/opt/gcc@9/lib/gcc/9/libgfortran.5.dylib - ln -fs /usr/local/lib/gcc/${GCC_V}/libgcc_s.1.dylib /usr/local/lib/gcc/9/libgcc_s.1.dylib + - name: Set up Homebrew + id: set-up-homebrew + uses: Homebrew/actions/setup-homebrew@master # Phase 1: Bootstrap fpm with existing version - name: Install fpm From 3d49f4621ffdd0ad7bce55fa010a726da8680f6c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 12:05:28 +0200 Subject: [PATCH 067/304] indent --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index c8f816194b..93cfeec4b3 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -37,7 +37,7 @@ jobs: uses: actions/checkout@v1 - name: Set up Homebrew - id: set-up-homebrew + id: set-up-homebrew uses: Homebrew/actions/setup-homebrew@master # Phase 1: Bootstrap fpm with existing version From 4dbf0064f1b92f37c754a5069380815ee2dcae12 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 12:17:34 +0200 Subject: [PATCH 068/304] install gcc --- .github/workflows/meta.yml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 93cfeec4b3..af1f3f3316 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -40,6 +40,12 @@ jobs: id: set-up-homebrew uses: Homebrew/actions/setup-homebrew@master + - name: Install Homebrew gfortran + if: matrix.os.contains('macos') + shell: bash + run: brew install gcc@${{ GCC_V }} + + # Phase 1: Bootstrap fpm with existing version - name: Install fpm uses: fortran-lang/setup-fpm@v3 From 611a6d7b444dc4362b87ca83ee74884092178696 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 12:19:17 +0200 Subject: [PATCH 069/304] Update meta.yml --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index af1f3f3316..1fbf23a5e9 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -43,7 +43,7 @@ jobs: - name: Install Homebrew gfortran if: matrix.os.contains('macos') shell: bash - run: brew install gcc@${{ GCC_V }} + run: brew install gcc@${GCC_V} # Phase 1: Bootstrap fpm with existing version From aea4ef0893bb604b318e739e51f018add9f4b30e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 12:21:14 +0200 Subject: [PATCH 070/304] Update meta.yml --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 1fbf23a5e9..ed2b28d63d 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -41,7 +41,7 @@ jobs: uses: Homebrew/actions/setup-homebrew@master - name: Install Homebrew gfortran - if: matrix.os.contains('macos') + if: contains(matrix.os, 'macos') shell: bash run: brew install gcc@${GCC_V} From fbd312bba5904f971dfddeb1d0b8810d2c053fc3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 12:25:50 +0200 Subject: [PATCH 071/304] check gfortran gfortran-10 --- .github/workflows/meta.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index ed2b28d63d..c294598bdc 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -44,6 +44,8 @@ jobs: if: contains(matrix.os, 'macos') shell: bash run: brew install gcc@${GCC_V} + which gfortran-${GCC_V} + which gfortran # Phase 1: Bootstrap fpm with existing version From 3d967b791cbf5ce3681ff6c92afa2a9716edce21 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 12:29:20 +0200 Subject: [PATCH 072/304] Update meta.yml --- .github/workflows/meta.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index c294598bdc..4d6640053c 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -42,8 +42,8 @@ jobs: - name: Install Homebrew gfortran if: contains(matrix.os, 'macos') - shell: bash - run: brew install gcc@${GCC_V} + run: | + brew install gcc@${GCC_V} which gfortran-${GCC_V} which gfortran From 5a229800091df4ae52968c8217099fbdeac58f63 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 12:35:42 +0200 Subject: [PATCH 073/304] install mpich --- .github/workflows/meta.yml | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 4d6640053c..558cd65bbc 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -21,7 +21,8 @@ jobs: strategy: fail-fast: false matrix: - os: [macos-11] + os: [macos-11] + mpi: [mpich] gcc_v: [10] # Version of GFortran we want to use include: - os: macos-11 @@ -44,9 +45,14 @@ jobs: if: contains(matrix.os, 'macos') run: | brew install gcc@${GCC_V} + ln -s /usr/local/bin/gfortran-${GCC_V} /usr/local/bin/gfortran which gfortran-${GCC_V} which gfortran - + + - name: Install homebrew MPICH + if: contains(matrix.mpi,'mpich') + run: | + brew install mpich # Phase 1: Bootstrap fpm with existing version - name: Install fpm From 5e6f3b6e0add539927f52e53aaefa9c3cbfc5a9a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 12:44:03 +0200 Subject: [PATCH 074/304] add homebrew OpenMPI case --- .github/workflows/meta.yml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 558cd65bbc..e17805d479 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -22,7 +22,7 @@ jobs: fail-fast: false matrix: os: [macos-11] - mpi: [mpich] + mpi: [mpich,openmpi] gcc_v: [10] # Version of GFortran we want to use include: - os: macos-11 @@ -54,6 +54,11 @@ jobs: run: | brew install mpich + - name: Install homebrew OpenMPI + if: contains(matrix.mpi,'openmpi') + run: | + brew install --cc=gcc-${GCC_V} openmpi + # Phase 1: Bootstrap fpm with existing version - name: Install fpm uses: fortran-lang/setup-fpm@v3 From 1406197a1045520b007e049ddc963ffe20177f14 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 13:00:59 +0200 Subject: [PATCH 075/304] add windows image --- .github/workflows/meta.yml | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index e17805d479..5154f08db6 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -21,13 +21,17 @@ jobs: strategy: fail-fast: false matrix: - os: [macos-11] + os: [macos-11,windows-2019] mpi: [mpich,openmpi] gcc_v: [10] # Version of GFortran we want to use include: - os: macos-11 os-arch: macos-x86_64 release-flags: --flag '-g -fbacktrace -O3' + - os: windows-2019 + os-arch: windows-x86_64 + release-flags: --flag '--static -g -fbacktrace -O3' + exe: .exe env: FC: gfortran @@ -37,7 +41,19 @@ jobs: - name: Checkout code uses: actions/checkout@v1 + - name: Set up MSYS2 and gfortran + uses: msys2/setup-msys2@v2 + if: contains(matrix.os,'windows') + with: + msystem: MINGW64 + update: false + install: >- + wget + unzip + gcc-fortran + - name: Set up Homebrew + if: contains(matrix.os,'macos') id: set-up-homebrew uses: Homebrew/actions/setup-homebrew@master From 9e6d0eccf24f2e0a418f85c0f754277da1611ac1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 13:06:46 +0200 Subject: [PATCH 076/304] add MSMPI type --- .github/workflows/meta.yml | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 5154f08db6..a7ecb74778 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -22,7 +22,7 @@ jobs: fail-fast: false matrix: os: [macos-11,windows-2019] - mpi: [mpich,openmpi] + mpi: [mpich,openmpi,msmpi] gcc_v: [10] # Version of GFortran we want to use include: - os: macos-11 @@ -51,6 +51,7 @@ jobs: wget unzip gcc-fortran + msmpi - name: Set up Homebrew if: contains(matrix.os,'macos') @@ -67,14 +68,21 @@ jobs: - name: Install homebrew MPICH if: contains(matrix.mpi,'mpich') + if: contains(matrix.os,'macos') run: | brew install mpich - name: Install homebrew OpenMPI if: contains(matrix.mpi,'openmpi') + if: contains(matrix.os,'macos') run: | brew install --cc=gcc-${GCC_V} openmpi + - name: Install MSYS2 MSMPI + if: contains(matrix.mpi,'msmpi') + if: contains(matrix.os,'windows') + run: | + # Phase 1: Bootstrap fpm with existing version - name: Install fpm uses: fortran-lang/setup-fpm@v3 From 5785c3de139025581d91303eb3b600498697175b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 13:20:39 +0200 Subject: [PATCH 077/304] duplicate ifs --- .github/workflows/meta.yml | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index a7ecb74778..5f2f770b6f 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -67,20 +67,17 @@ jobs: which gfortran - name: Install homebrew MPICH - if: contains(matrix.mpi,'mpich') - if: contains(matrix.os,'macos') + if: contains(matrix.mpi,'mpich') && contains(matrix.os,'macos') run: | brew install mpich - name: Install homebrew OpenMPI - if: contains(matrix.mpi,'openmpi') - if: contains(matrix.os,'macos') + if: contains(matrix.mpi,'openmpi') && contains(matrix.os,'macos') run: | brew install --cc=gcc-${GCC_V} openmpi - name: Install MSYS2 MSMPI - if: contains(matrix.mpi,'msmpi') - if: contains(matrix.os,'windows') + if: contains(matrix.mpi,'msmpi') && contains(matrix.os,'windows') run: | # Phase 1: Bootstrap fpm with existing version From bf221729d7c1b3fd0021dfcd368d1bfc4c9988e0 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 13:36:20 +0200 Subject: [PATCH 078/304] reduce matrix --- .github/workflows/meta.yml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 5f2f770b6f..fdf7565eea 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -21,15 +21,19 @@ jobs: strategy: fail-fast: false matrix: - os: [macos-11,windows-2019] - mpi: [mpich,openmpi,msmpi] gcc_v: [10] # Version of GFortran we want to use include: - os: macos-11 os-arch: macos-x86_64 + mpi: openmpi + release-flags: --flag '-g -fbacktrace -O3' + - os: macos-11 + os-arch: macos-x86_64 + mpi: mpich release-flags: --flag '-g -fbacktrace -O3' - os: windows-2019 os-arch: windows-x86_64 + mpi: msmpi release-flags: --flag '--static -g -fbacktrace -O3' exe: .exe From 7bff6fa80a027db1b547747dc91a518bda601d2b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 13:58:30 +0200 Subject: [PATCH 079/304] Revert "reduce matrix" This reverts commit bf221729d7c1b3fd0021dfcd368d1bfc4c9988e0. --- .github/workflows/meta.yml | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index fdf7565eea..5f2f770b6f 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -21,19 +21,15 @@ jobs: strategy: fail-fast: false matrix: + os: [macos-11,windows-2019] + mpi: [mpich,openmpi,msmpi] gcc_v: [10] # Version of GFortran we want to use include: - os: macos-11 os-arch: macos-x86_64 - mpi: openmpi - release-flags: --flag '-g -fbacktrace -O3' - - os: macos-11 - os-arch: macos-x86_64 - mpi: mpich release-flags: --flag '-g -fbacktrace -O3' - os: windows-2019 os-arch: windows-x86_64 - mpi: msmpi release-flags: --flag '--static -g -fbacktrace -O3' exe: .exe From 53a20960480594dade1218c3a4ff3b5885ff2447 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 13:59:42 +0200 Subject: [PATCH 080/304] reduce matrix --- .github/workflows/meta.yml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 5f2f770b6f..a58052883e 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -24,6 +24,13 @@ jobs: os: [macos-11,windows-2019] mpi: [mpich,openmpi,msmpi] gcc_v: [10] # Version of GFortran we want to use + exclude: + - os: macos-11 + mpi: msmpi + - os: windows-2019 + mpi: mpich + - os: windows-2019 + mpi: openmpi include: - os: macos-11 os-arch: macos-x86_64 From aaa519529bedfd74e5ea2ffa40b423980584390e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 14:04:40 +0200 Subject: [PATCH 081/304] improve windows CI --- .github/workflows/meta.yml | 35 ++++++++++++++++++++++++++++------- 1 file changed, 28 insertions(+), 7 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index a58052883e..75ea7f4460 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -48,17 +48,38 @@ jobs: - name: Checkout code uses: actions/checkout@v1 - - name: Set up MSYS2 and gfortran - uses: msys2/setup-msys2@v2 + - uses: msys2/setup-msys2@v2 if: contains(matrix.os,'windows') with: msystem: MINGW64 - update: false + update: true install: >- - wget - unzip - gcc-fortran - msmpi + mingw-w64-x86_64-wget + mingw-w64-x86_64-unzip + mingw-w64-x86_64-gcc-fortran + mingw-w64-x86_64-msmpi + + - name: Put MSYS2_MinGW64 on PATH + if: contains(matrix.os,'windows') + # there is not yet an environment variable for this path from msys2/setup-msys2 + run: echo "${{ runner.temp }}/msys64/mingw64/bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append + + - name: download MS-MPI setup (SDK is from MSYS2) + if: contains(matrix.os,'windows') + run: curl -L -O https://github.com/microsoft/Microsoft-MPI/releases/download/v10.1.1/msmpisetup.exe + + - name: Install mpiexec.exe (-force needed to bypass GUI on headless) + if: contains(matrix.os,'windows') + run: .\msmpisetup.exe -unattend -force + + - name: test that mpiexec.exe exists + if: contains(matrix.os,'windows') + # can't use MSMPI_BIN as Actions doesn't update PATH from msmpisetup.exe + run: Test-Path "C:\Program Files\Microsoft MPI\Bin\mpiexec.exe" -PathType leaf + + - name: put MSMPI_BIN on PATH (where mpiexec is) + if: contains(matrix.os,'windows') + run: echo "C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append - name: Set up Homebrew if: contains(matrix.os,'macos') From 1309f501619c007bd1140f5686dd31dd90762476 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 14:08:13 +0200 Subject: [PATCH 082/304] Update meta.yml --- .github/workflows/meta.yml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 75ea7f4460..b19ae577f6 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -54,10 +54,11 @@ jobs: msystem: MINGW64 update: true install: >- - mingw-w64-x86_64-wget - mingw-w64-x86_64-unzip - mingw-w64-x86_64-gcc-fortran - mingw-w64-x86_64-msmpi + wget + unzip + curl + gcc-fortran + msmpi - name: Put MSYS2_MinGW64 on PATH if: contains(matrix.os,'windows') From b7879bfe1556d8fa6fbfeab00eb978305c8f0832 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 14:14:14 +0200 Subject: [PATCH 083/304] use windows-latest --- .github/workflows/meta.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index b19ae577f6..0866a44c49 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -21,21 +21,21 @@ jobs: strategy: fail-fast: false matrix: - os: [macos-11,windows-2019] + os: [macos-11,windows-latest] mpi: [mpich,openmpi,msmpi] gcc_v: [10] # Version of GFortran we want to use exclude: - os: macos-11 mpi: msmpi - - os: windows-2019 + - os: windows-latest mpi: mpich - - os: windows-2019 + - os: windows-latest mpi: openmpi include: - os: macos-11 os-arch: macos-x86_64 release-flags: --flag '-g -fbacktrace -O3' - - os: windows-2019 + - os: windows-latest os-arch: windows-x86_64 release-flags: --flag '--static -g -fbacktrace -O3' exe: .exe From 391b4058ba26ed51a4a49a3f5e57207dc25ad4fb Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 14:27:25 +0200 Subject: [PATCH 084/304] Update meta.yml --- .github/workflows/meta.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 0866a44c49..ea3aef00b6 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -54,6 +54,8 @@ jobs: msystem: MINGW64 update: true install: >- + git + base-devel wget unzip curl From 20c6cbaf959079953945b069b3835e9948959ea0 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 14:35:31 +0200 Subject: [PATCH 085/304] change order --- .github/workflows/meta.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index ea3aef00b6..26c26f9f54 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -60,7 +60,6 @@ jobs: unzip curl gcc-fortran - msmpi - name: Put MSYS2_MinGW64 on PATH if: contains(matrix.os,'windows') @@ -84,6 +83,10 @@ jobs: if: contains(matrix.os,'windows') run: echo "C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append + - name: Install MSYS2 msmpi package + if: contains(matrix.os,'windows') + run: pacman -Ss msmpi + - name: Set up Homebrew if: contains(matrix.os,'macos') id: set-up-homebrew From 85e3565b68d95f94229a706b606393c0fc0d03de Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 14:44:13 +0200 Subject: [PATCH 086/304] install msmpi --- .github/workflows/meta.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 26c26f9f54..435256db84 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -85,7 +85,8 @@ jobs: - name: Install MSYS2 msmpi package if: contains(matrix.os,'windows') - run: pacman -Ss msmpi + shell: msys2 {0} + run: pacman --noconfirm -S mingw-w64-x86_64-msmpi - name: Set up Homebrew if: contains(matrix.os,'macos') From 7518c81a1f7c39931385c639d45ad360af83c202 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 14:54:17 +0200 Subject: [PATCH 087/304] fix $PATH --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 435256db84..c26860a7de 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -64,7 +64,7 @@ jobs: - name: Put MSYS2_MinGW64 on PATH if: contains(matrix.os,'windows') # there is not yet an environment variable for this path from msys2/setup-msys2 - run: echo "${{ runner.temp }}/msys64/mingw64/bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append + run: echo "${{ runner.temp }}/msys64/mingw64/bin" | Out-File -FilePath $GITHUB_PATH -Encoding utf8 -Append - name: download MS-MPI setup (SDK is from MSYS2) if: contains(matrix.os,'windows') From 3e5de3705c5a5d37f7c312179257038cad1a706d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 15:07:49 +0200 Subject: [PATCH 088/304] fix path --- .github/workflows/meta.yml | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index c26860a7de..126d5603e5 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -64,7 +64,7 @@ jobs: - name: Put MSYS2_MinGW64 on PATH if: contains(matrix.os,'windows') # there is not yet an environment variable for this path from msys2/setup-msys2 - run: echo "${{ runner.temp }}/msys64/mingw64/bin" | Out-File -FilePath $GITHUB_PATH -Encoding utf8 -Append + run: echo "${{ runner.temp }}/msys64/mingw64/bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append - name: download MS-MPI setup (SDK is from MSYS2) if: contains(matrix.os,'windows') @@ -111,10 +111,6 @@ jobs: run: | brew install --cc=gcc-${GCC_V} openmpi - - name: Install MSYS2 MSMPI - if: contains(matrix.mpi,'msmpi') && contains(matrix.os,'windows') - run: | - # Phase 1: Bootstrap fpm with existing version - name: Install fpm uses: fortran-lang/setup-fpm@v3 From 87ed9c62e7892b1683c1775e7f579120d1c9bb4b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 15:10:58 +0200 Subject: [PATCH 089/304] search in Windows %PATH% --- src/fpm_meta.f90 | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index b64bc28529..ffce5af08a 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -554,8 +554,15 @@ logical function msmpi_init(this,compiler,error) result(found) if (allocated(error)) return bindir = get_env('MSMPI_BIN') - if (len_trim(bindir)<=0 .or. .not.exists(bindir)) then - call fatal_error(error,'MS-MPI error: MS-MPI Runtime directory is missing. check environment variable %MSMPI_BIN%.') + + ! In some environments, variable %MSMPI_BIN% is missing (i.e. in GitHub Action images). + ! Do a second attempt: search for mpiexec.exe + if (len_trim(bindir)<=0 .or. .not.exists(bindir)) & + call find_command_location('mpiexec.exe',bindir,verbose=verbose,error=error) + + if (allocated(error) .or. len_trim(bindir)<=0 .or. .not.exists(bindir)) then + call fatal_error(error,'MS-MPI error: MS-MPI Runtime directory is missing. '//& + 'check environment variable %MSMPI_BIN% or that the folder is in %PATH%.') return end if From 6d1a6ece9932f0d0bded46b6c99061fa6b02341a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 15:22:06 +0200 Subject: [PATCH 090/304] do not look for msmpi.dll --- src/fpm_meta.f90 | 9 --------- 1 file changed, 9 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index ffce5af08a..b8d1a02cd7 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -549,10 +549,6 @@ logical function msmpi_init(this,compiler,error) result(found) end if ! Check that the runtime is installed - windir = get_env('WINDIR') - call get_absolute_path(join_path(windir,'system32\msmpi.dll'),libdir,error) - if (allocated(error)) return - bindir = get_env('MSMPI_BIN') ! In some environments, variable %MSMPI_BIN% is missing (i.e. in GitHub Action images). @@ -566,11 +562,6 @@ logical function msmpi_init(this,compiler,error) result(found) return end if - if (len_trim(libdir)<=0 .or. .not.exists(libdir)) then - call fatal_error(error,'MS-MPI error: msmpi.dll is missing. Is MS-MPI installed on this system?') - return - end if - ! Success! found = .true. From 918336d9a97f89bfb87f5a21ee8fa81ada12632b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 15:29:46 +0200 Subject: [PATCH 091/304] fix bindir --- src/fpm_meta.f90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index b8d1a02cd7..e69d4a1dd0 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -553,10 +553,12 @@ logical function msmpi_init(this,compiler,error) result(found) ! In some environments, variable %MSMPI_BIN% is missing (i.e. in GitHub Action images). ! Do a second attempt: search for mpiexec.exe - if (len_trim(bindir)<=0 .or. .not.exists(bindir)) & - call find_command_location('mpiexec.exe',bindir,verbose=verbose,error=error) + if (len_trim(bindir)<=0 .or. .not.exists(bindir)) then + call find_command_location('mpiexec.exe',bindir,verbose=verbose,error=error) + if (allocated(error)) return + endif - if (allocated(error) .or. len_trim(bindir)<=0 .or. .not.exists(bindir)) then + if (allocated(error) .or. len_trim(bindir)<=0) then call fatal_error(error,'MS-MPI error: MS-MPI Runtime directory is missing. '//& 'check environment variable %MSMPI_BIN% or that the folder is in %PATH%.') return @@ -654,7 +656,7 @@ logical function msmpi_init(this,compiler,error) result(found) !> Add default run command this%has_run_command = .true. - this%run_command = string_t(join_path(get_dos_path(bindir,error),'mpiexec')//' -np * ') + this%run_command = string_t(join_path(get_dos_path(bindir,error),'mpiexec.exe')//' -np * ') else From a3184ad3cc4a67ba02dd7fb1ade02f408dddeb22 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 15:46:50 +0200 Subject: [PATCH 092/304] output path in case it is not a dir --- src/fpm_meta.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index e69d4a1dd0..4971c76256 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -741,7 +741,7 @@ subroutine find_command_location(command,path,echo,verbose,error) end if if (.not.is_dir(path)) then - call fatal_error(error,'full path to command ('//command//') is not a directory') + call fatal_error(error,'full path ('//path//') to command ('//command//') is not a directory') return end if From 847765d4d6808456f839d4e7665f463885d9239e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 16:05:20 +0200 Subject: [PATCH 093/304] do not use `canon_path`: returns inverse slashes on WSL! --- src/fpm_meta.f90 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 4971c76256..9c38041d52 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -669,6 +669,15 @@ logical function msmpi_init(this,compiler,error) result(found) end function msmpi_init +!> Check if we're under a WSL bash shell +logical function wsl_shell() + if (get_os_type()==OS_WINDOWS) then + wsl_shell = exists('/proc/sys/fs/binfmt_misc/WSLInterop') + else + wsl_shell = .false. + endif +end function wsl_shell + !> Find the location of a valid command subroutine find_command_location(command,path,echo,verbose,error) character(*), intent(in) :: command @@ -737,7 +746,7 @@ subroutine find_command_location(command,path,echo,verbose,error) ! Compiler is in the current folder call get_absolute_path('.',path,error) else - path = canon_path(fullpath(1:length-1)) + call get_absolute_path(fullpath(1:length-1),path,error) end if if (.not.is_dir(path)) then From 1e6f8bca3328ec3c09a36ba44a6928511ba840da Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 09:35:38 -0500 Subject: [PATCH 094/304] fix WSL paths --- src/fpm_meta.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 9c38041d52..c70a082de6 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -558,7 +558,7 @@ logical function msmpi_init(this,compiler,error) result(found) if (allocated(error)) return endif - if (allocated(error) .or. len_trim(bindir)<=0) then + if (allocated(error) .or. .not.exists(bindir)) then call fatal_error(error,'MS-MPI error: MS-MPI Runtime directory is missing. '//& 'check environment variable %MSMPI_BIN% or that the folder is in %PATH%.') return @@ -748,6 +748,10 @@ subroutine find_command_location(command,path,echo,verbose,error) else call get_absolute_path(fullpath(1:length-1),path,error) end if + if (allocated(error)) return + + ! On Windows, be sure to return a path with no spaces + if (get_os_type()==OS_WINDOWS) path = get_dos_path(path,error) if (.not.is_dir(path)) then call fatal_error(error,'full path ('//path//') to command ('//command//') is not a directory') From e9a4ceb63f7fd7c54e1a58f98c8dfccc02d8480d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 10:01:42 -0500 Subject: [PATCH 095/304] Only launch job if any metapackage source files have changed --- .github/workflows/meta.yml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 126d5603e5..a7561abdbc 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -2,6 +2,10 @@ name: metapackage-tests on: push: + paths: + - 'src/*meta*.f90' # On push, only launch job if something has changed in the metapackages + - 'src/fpm/*meta*.f90' + - 'src/fpm/manifest/*meta*.f90' pull_request: release: types: [published] From 43b670e085a1322a2616b2e77ac3bf3453535947 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 17:31:36 +0200 Subject: [PATCH 096/304] remove unnecessary verbosity --- src/fpm_meta.f90 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index c70a082de6..c414127a59 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -93,10 +93,8 @@ module fpm_meta integer, parameter :: MPI_TYPE_INTEL = 3 integer, parameter :: MPI_TYPE_MSMPI = 4 - - !> Debugging information -logical, parameter, private :: verbose = .true. +logical, parameter, private :: verbose = .false. integer, parameter, private :: WRAPPER_FORTRAN = 1 integer, parameter, private :: WRAPPER_C = 2 @@ -772,7 +770,7 @@ subroutine get_mpi_runner(command,verbose,error) ! Try several commands do itri=1,size(try) - call find_command_location(trim(try(itri)),command%s,verbose=verbose,error=error) + call find_command_location(trim(try(itri)),command%s,echo=.false.,verbose=verbose,error=error) ! Success! success = len_trim(command%s)>0 .and. .not.allocated(error) @@ -795,7 +793,7 @@ subroutine compiler_get_path(self,path,error) type(string_t), intent(out) :: path type(error_t), allocatable, intent(out) :: error - call find_command_location(self%fc,path%s,self%echo,self%verbose,error) + call find_command_location(self%fc,path%s,.false.,self%verbose,error) end subroutine compiler_get_path From 8d6cc28f5cc85d8cee7638b26337884c5c9c196d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 11:24:57 -0500 Subject: [PATCH 097/304] Revert "remove unnecessary verbosity" This reverts commit 43b670e085a1322a2616b2e77ac3bf3453535947. --- src/fpm_meta.f90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index c414127a59..c70a082de6 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -93,8 +93,10 @@ module fpm_meta integer, parameter :: MPI_TYPE_INTEL = 3 integer, parameter :: MPI_TYPE_MSMPI = 4 + + !> Debugging information -logical, parameter, private :: verbose = .false. +logical, parameter, private :: verbose = .true. integer, parameter, private :: WRAPPER_FORTRAN = 1 integer, parameter, private :: WRAPPER_C = 2 @@ -770,7 +772,7 @@ subroutine get_mpi_runner(command,verbose,error) ! Try several commands do itri=1,size(try) - call find_command_location(trim(try(itri)),command%s,echo=.false.,verbose=verbose,error=error) + call find_command_location(trim(try(itri)),command%s,verbose=verbose,error=error) ! Success! success = len_trim(command%s)>0 .and. .not.allocated(error) @@ -793,7 +795,7 @@ subroutine compiler_get_path(self,path,error) type(string_t), intent(out) :: path type(error_t), allocatable, intent(out) :: error - call find_command_location(self%fc,path%s,.false.,self%verbose,error) + call find_command_location(self%fc,path%s,self%echo,self%verbose,error) end subroutine compiler_get_path From 53719bf60bf42594b843a4e5e3127d5603f3ef78 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 21 Apr 2023 11:36:22 -0500 Subject: [PATCH 098/304] fix run api --- src/fpm_meta.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index c70a082de6..b70e366589 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -96,7 +96,7 @@ module fpm_meta !> Debugging information -logical, parameter, private :: verbose = .true. +logical, parameter, private :: verbose = .false. integer, parameter, private :: WRAPPER_FORTRAN = 1 integer, parameter, private :: WRAPPER_C = 2 @@ -696,9 +696,9 @@ subroutine find_command_location(command,path,echo,verbose,error) tmp_file = get_temp_filename() if (get_os_type()==OS_WINDOWS) then - call run("where "//command, echo=echo, verbose=verbose, redirect=tmp_file, exitstat=stat) + call run("where "//command, echo=echo, exitstat=stat, verbose=verbose, redirect=tmp_file) else - call run("which "//command, echo=echo, verbose=verbose, redirect=tmp_file, exitstat=stat) + call run("which "//command, echo=echo, exitstat=stat, verbose=verbose, redirect=tmp_file) end if if (stat/=0) then call fatal_error(error,'compiler_get_path failed for '//command) From b7c71e3642ee840b04221ddb9c28dba5d5c23955 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 27 Apr 2023 02:14:57 -0500 Subject: [PATCH 099/304] add ubuntu --- .github/workflows/meta.yml | 44 ++++++++++++++++++++++---------------- 1 file changed, 26 insertions(+), 18 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index a7561abdbc..9e99df547f 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -6,6 +6,8 @@ on: - 'src/*meta*.f90' # On push, only launch job if something has changed in the metapackages - 'src/fpm/*meta*.f90' - 'src/fpm/manifest/*meta*.f90' + - 'src/ci/meta_tests.sh' + - 'src/.github/workflows/meta.yml' pull_request: release: types: [published] @@ -25,12 +27,18 @@ jobs: strategy: fail-fast: false matrix: - os: [macos-11,windows-latest] - mpi: [mpich,openmpi,msmpi] - gcc_v: [10] # Version of GFortran we want to use + os: [macos-11,windows-latest,ubuntu-latest] + mpi: [mpich,openmpi,msmpi] + gcc_v: [10] # Version of GFortran we want to use exclude: - os: macos-11 mpi: msmpi + - os: macos-11 # temporary + mpi: openmpi + - os: macos-11 # temporary + mpi: mpich + - os: windows-latest # temporary + mpi: msmpi - os: windows-latest mpi: mpich - os: windows-latest @@ -55,7 +63,7 @@ jobs: - uses: msys2/setup-msys2@v2 if: contains(matrix.os,'windows') with: - msystem: MINGW64 + msystem: MINGW64 update: true install: >- git @@ -65,52 +73,52 @@ jobs: curl gcc-fortran - - name: Put MSYS2_MinGW64 on PATH + - name: (Windows) Put MSYS2_MinGW64 on PATH if: contains(matrix.os,'windows') # there is not yet an environment variable for this path from msys2/setup-msys2 run: echo "${{ runner.temp }}/msys64/mingw64/bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append - - name: download MS-MPI setup (SDK is from MSYS2) + - name: (Windows) download MS-MPI setup (SDK is from MSYS2) if: contains(matrix.os,'windows') run: curl -L -O https://github.com/microsoft/Microsoft-MPI/releases/download/v10.1.1/msmpisetup.exe - - name: Install mpiexec.exe (-force needed to bypass GUI on headless) + - name: (Windows) Install mpiexec.exe (-force needed to bypass GUI on headless) if: contains(matrix.os,'windows') run: .\msmpisetup.exe -unattend -force - - name: test that mpiexec.exe exists + - name: (Windows) test that mpiexec.exe exists if: contains(matrix.os,'windows') # can't use MSMPI_BIN as Actions doesn't update PATH from msmpisetup.exe run: Test-Path "C:\Program Files\Microsoft MPI\Bin\mpiexec.exe" -PathType leaf - - name: put MSMPI_BIN on PATH (where mpiexec is) + - name: (Windows) put MSMPI_BIN on PATH (where mpiexec is) if: contains(matrix.os,'windows') run: echo "C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append - - name: Install MSYS2 msmpi package + - name: (Windows) Install MSYS2 msmpi package if: contains(matrix.os,'windows') shell: msys2 {0} run: pacman --noconfirm -S mingw-w64-x86_64-msmpi - - name: Set up Homebrew + - name: (macOS) Set up Homebrew if: contains(matrix.os,'macos') id: set-up-homebrew - uses: Homebrew/actions/setup-homebrew@master + uses: Homebrew/actions/setup-homebrew@master - - name: Install Homebrew gfortran + - name: (macOS) Install Homebrew gfortran if: contains(matrix.os, 'macos') run: | brew install gcc@${GCC_V} ln -s /usr/local/bin/gfortran-${GCC_V} /usr/local/bin/gfortran which gfortran-${GCC_V} which gfortran - - - name: Install homebrew MPICH + + - name: (macOS) Install homebrew MPICH if: contains(matrix.mpi,'mpich') && contains(matrix.os,'macos') run: | brew install mpich - - name: Install homebrew OpenMPI + - name: (macOS) Install homebrew OpenMPI if: contains(matrix.mpi,'openmpi') && contains(matrix.os,'macos') run: | brew install --cc=gcc-${GCC_V} openmpi @@ -130,7 +138,7 @@ jobs: - name: Build Fortran fpm (bootstrap) shell: bash run: | - ${{ env.BOOTSTRAP }} build + ${{ env.BOOTSTRAP }} build - name: Run Fortran fpm (bootstrap) shell: bash @@ -201,7 +209,7 @@ jobs: env: EXE: fpm-${{ env.VERSION }}-${{ matrix.os-arch }}${{ matrix.exe }} - - name: Run metapackage tests using the release version + - name: Run metapackage tests using the release version shell: bash run: | ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" From 3632e1da4b02893017d864888debbdef1458b196 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 27 Apr 2023 04:11:39 -0500 Subject: [PATCH 100/304] unix -fpp macro fix --- src/fpm.f90 | 12 ++++++------ src/fpm/dependency.f90 | 6 +++--- src/fpm_command_line.f90 | 8 ++++---- src/fpm_environment.f90 | 4 ++-- src/fpm_filesystem.F90 | 6 +++--- 5 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 07666fb2f9..c8ff464d79 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -663,9 +663,9 @@ end subroutine compact_list end subroutine cmd_run -subroutine delete_skip(unix) +subroutine delete_skip(is_unix) !> delete directories in the build folder, skipping dependencies - logical, intent(in) :: unix + logical, intent(in) :: is_unix character(len=:), allocatable :: dir type(string_t), allocatable :: files(:) integer :: i @@ -673,7 +673,7 @@ subroutine delete_skip(unix) do i = 1, size(files) if (is_dir(files(i)%s)) then dir = files(i)%s - if (.not.str_ends_with(dir,'dependencies')) call os_delete_dir(unix, dir) + if (.not.str_ends_with(dir,'dependencies')) call os_delete_dir(is_unix, dir) end if end do end subroutine delete_skip @@ -687,18 +687,18 @@ subroutine cmd_clean(settings) if (is_dir('build')) then ! remove the entire build directory if (settings%clean_call) then - call os_delete_dir(settings%unix, 'build') + call os_delete_dir(settings%is_unix, 'build') return end if ! remove the build directory but skip dependencies if (settings%clean_skip) then - call delete_skip(settings%unix) + call delete_skip(settings%is_unix) return end if ! prompt to remove the build directory but skip dependencies write(stdout, '(A)', advance='no') "Delete build, excluding dependencies (y/n)? " read(stdin, '(A1)') response - if (lower(response) == 'y') call delete_skip(settings%unix) + if (lower(response) == 'y') call delete_skip(settings%is_unix) else write (stdout, '(A)') "fpm: No build directory found." end if diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index d89b6eb836..e8804006ee 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -1014,7 +1014,7 @@ subroutine load_from_toml(self, table, error) type(error_t), allocatable, intent(out) :: error integer :: ndep, ii - logical :: unix + logical :: is_unix character(len=:), allocatable :: version, url, obj, rev, proj_dir type(toml_key), allocatable :: list(:) type(toml_table), pointer :: ptr @@ -1026,7 +1026,7 @@ subroutine load_from_toml(self, table, error) call resize(self%dep, ndep + ndep/2 + size(list)) end if - unix = get_os_type() /= OS_WINDOWS + is_unix = get_os_type() /= OS_WINDOWS do ii = 1, size(list) call get_value(table, list(ii)%key, ptr) @@ -1039,7 +1039,7 @@ subroutine load_from_toml(self, table, error) self%ndep = self%ndep + 1 associate (dep => self%dep(self%ndep)) dep%name = list(ii)%key - if (unix) then + if (is_unix) then dep%proj_dir = proj_dir else dep%proj_dir = windows_path(proj_dir) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 867eecb76a..1f52f42558 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -111,7 +111,7 @@ module fpm_command_line end type type, extends(fpm_cmd_settings) :: fpm_clean_settings - logical :: unix + logical :: is_unix character(len=:), allocatable :: calling_dir ! directory clean called from logical :: clean_skip=.false. logical :: clean_call=.false. @@ -209,7 +209,7 @@ subroutine get_command_line_settings(cmd_settings) character(len=4096) :: cmdarg integer :: i integer :: os - logical :: unix + logical :: is_unix type(fpm_install_settings), allocatable :: install_settings type(version_t) :: version character(len=:), allocatable :: common_args, compiler_args, run_args, working_dir, & @@ -235,7 +235,7 @@ subroutine get_command_line_settings(cmd_settings) case (OS_UNKNOWN); os_type = "OS Type: Unknown" case default ; os_type = "OS Type: UNKNOWN" end select - unix = os_is_unix(os) + is_unix = os_is_unix(os) ! Get current release version version = fpm_version() @@ -603,7 +603,7 @@ subroutine get_command_line_settings(cmd_settings) allocate(fpm_clean_settings :: cmd_settings) call get_current_directory(working_dir, error) cmd_settings=fpm_clean_settings( & - & unix=unix, & + & is_unix=is_unix, & & calling_dir=working_dir, & & clean_skip=lget('skip'), & clean_call=lget('all')) diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index c8bd9be5d5..7e8aa2317d 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -145,7 +145,7 @@ end function get_os_type !> Compare the output of [[get_os_type]] or the optional !! passed INTEGER value to the value for OS_WINDOWS !! and return .TRUE. if they match and .FALSE. otherwise - logical function os_is_unix(os) result(unix) + logical function os_is_unix(os) integer, intent(in), optional :: os integer :: build_os if (present(os)) then @@ -153,7 +153,7 @@ logical function os_is_unix(os) result(unix) else build_os = get_os_type() end if - unix = build_os /= OS_WINDOWS + os_is_unix = build_os /= OS_WINDOWS end function os_is_unix !> get named environment variable value. It it is blank or diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 3846654354..aa771ab8c3 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -927,12 +927,12 @@ subroutine run(cmd,echo,exitstat,verbose,redirect) end subroutine run !> Delete directory using system OS remove directory commands -subroutine os_delete_dir(unix, dir, echo) - logical, intent(in) :: unix +subroutine os_delete_dir(is_unix, dir, echo) + logical, intent(in) :: is_unix character(len=*), intent(in) :: dir logical, intent(in), optional :: echo - if (unix) then + if (is_unix) then call run('rm -rf ' // dir, echo=echo,verbose=.false.) else call run('rmdir /s/q ' // dir, echo=echo,verbose=.false.) From 831f284b736e7f29675e0bfabaa0074ccfb4c628 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 27 Apr 2023 05:50:19 -0500 Subject: [PATCH 101/304] base ifort implementation --- src/fpm_compiler.F90 | 12 +- src/fpm_meta.f90 | 282 +++++++++++++++++++++++++++++++------------ 2 files changed, 215 insertions(+), 79 deletions(-) diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index 374a3ad3ce..54b146a4ef 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -105,6 +105,8 @@ module fpm_compiler procedure :: link !> Check whether compiler is recognized procedure :: is_unknown + !> Check whether this is an Intel compiler + procedure :: is_intel !> Enumerate libraries, based on compiler and platform procedure :: enumerate_libraries !> Return compiler name @@ -203,7 +205,7 @@ module fpm_compiler flag_nag_openmp = " -openmp", & flag_nag_free_form = " -free", & flag_nag_fixed_form = " -fixed", & - flag_nag_no_implicit_typing = " -u" + flag_nag_no_implicit_typing = " -u" character(*), parameter :: & flag_lfortran_opt = " --fast", & @@ -217,7 +219,7 @@ module fpm_compiler flag_cray_implicit_typing = " -el", & flag_cray_fixed_form = " -ffixed", & flag_cray_free_form = " -ffree" - + contains @@ -891,6 +893,12 @@ pure function is_unknown(self) is_unknown = self%id == id_unknown end function is_unknown +pure logical function is_intel(self) + class(compiler_t), intent(in) :: self + is_intel = any(self%id == [id_intel_classic_nix,id_intel_classic_mac,id_intel_classic_windows, & + id_intel_llvm_nix,id_intel_llvm_windows,id_intel_llvm_unknown]) +end function is_intel + !> !> Enumerate libraries, based on compiler and platform !> diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index b70e366589..f246486dd4 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -92,18 +92,31 @@ module fpm_meta integer, parameter :: MPI_TYPE_MPICH = 2 integer, parameter :: MPI_TYPE_INTEL = 3 integer, parameter :: MPI_TYPE_MSMPI = 4 - - +public :: MPI_TYPE_NAME !> Debugging information logical, parameter, private :: verbose = .false. -integer, parameter, private :: WRAPPER_FORTRAN = 1 -integer, parameter, private :: WRAPPER_C = 2 -integer, parameter, private :: WRAPPER_CXX = 3 +integer, parameter, private :: LANG_FORTRAN = 1 +integer, parameter, private :: LANG_C = 2 +integer, parameter, private :: LANG_CXX = 3 contains +!> Return a name for the MPI library +pure function MPI_TYPE_NAME(mpilib) result(name) + integer, intent(in) :: mpilib + character(len=:), allocatable :: name + select case (mpilib) + case (MPI_TYPE_NONE); name = "none" + case (MPI_TYPE_OPENMPI); name = "OpenMPI" + case (MPI_TYPE_MPICH); name = "MPICH" + case (MPI_TYPE_INTEL); name = "INTELMPI" + case (MPI_TYPE_MSMPI); name = "MS-MPI" + case default; name = "UNKNOWN" + end select +end function MPI_TYPE_NAME + !> Clean the metapackage structure elemental subroutine destroy(this) class(metapackage_t), intent(inout) :: this @@ -420,18 +433,25 @@ subroutine init_mpi(this,compiler,error) type(string_t) :: output,fwrap,cwrap,cxxwrap character(256) :: msg_out character(len=:), allocatable :: tokens(:) - integer :: wcfit(3),ic,icpp,i + integer :: wcfit(3),mpilib(3),ic,icpp,i logical :: found !> Cleanup call destroy(this) + print *, 'init wrappers' + !> Get all candidate MPI wrappers call mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) if (verbose) print 1, size(fort_wrappers),size(c_wrappers),size(cpp_wrappers) - wcfit = wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,error) + print *, 'wrapper compiler fit' + + call wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,wcfit,mpilib,error) + + print *, 'wcfit = ',wcfit + print *, 'mpilib = ',mpilib if (allocated(error) .or. all(wcfit==0)) then @@ -447,21 +467,23 @@ subroutine init_mpi(this,compiler,error) else - if (wcfit(WRAPPER_FORTRAN)>0) fwrap = fort_wrappers(wcfit(WRAPPER_FORTRAN)) - if (wcfit(WRAPPER_C)>0) cwrap = c_wrappers (wcfit(WRAPPER_C)) - if (wcfit(WRAPPER_CXX)>0) cxxwrap = cpp_wrappers (wcfit(WRAPPER_CXX)) + if (wcfit(LANG_FORTRAN)>0) fwrap = fort_wrappers(wcfit(LANG_FORTRAN)) + if (wcfit(LANG_C)>0) cwrap = c_wrappers (wcfit(LANG_C)) + if (wcfit(LANG_CXX)>0) cxxwrap = cpp_wrappers (wcfit(LANG_CXX)) + + print *, 'wcfit' !> If there's only an available Fortran wrapper, and the compiler's different than fpm's baseline !> fortran compiler suite, we still want to enable C language flags as that is most likely being !> ABI-compatible anyways. However, issues may arise. !> see e.g. Homebrew with clabng C/C++ and GNU fortran at https://gitlab.kitware.com/cmake/cmake/-/issues/18139 - if (wcfit(WRAPPER_FORTRAN)>0 .and. wcfit(WRAPPER_C)==0 .and. wcfit(WRAPPER_CXX)==0) then - cwrap = fort_wrappers(wcfit(WRAPPER_FORTRAN)) - cxxwrap = fort_wrappers(wcfit(WRAPPER_FORTRAN)) + if (wcfit(LANG_FORTRAN)>0 .and. wcfit(LANG_C)==0 .and. wcfit(LANG_CXX)==0) then + cwrap = fort_wrappers(wcfit(LANG_FORTRAN)) + cxxwrap = fort_wrappers(wcfit(LANG_FORTRAN)) end if !> Initialize MPI package from wrapper command - call init_mpi_from_wrappers(this,compiler,fwrap,cwrap,cxxwrap,error) + call init_mpi_from_wrappers(this,compiler,mpilib(LANG_FORTRAN),fwrap,cwrap,cxxwrap,error) if (allocated(error)) return end if @@ -479,17 +501,17 @@ logical function is_64bit_environment() end function is_64bit_environment !> Check if there is a wrapper-compiler fit -function wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,error) result(wrap) +subroutine wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,wrap,mpi,error) type(string_t), allocatable, intent(in) :: fort_wrappers(:),c_wrappers(:),cpp_wrappers(:) type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error - integer :: wrap(3) + integer, intent(out), dimension(3) :: wrap, mpi logical :: has_wrappers - integer :: mpif90,mpic,mpicxx type(error_t), allocatable :: wrap_error wrap = 0 + mpi = MPI_TYPE_NONE !> Were any wrappers found? has_wrappers = size(fort_wrappers)*size(c_wrappers)*size(cpp_wrappers)>0 @@ -497,9 +519,9 @@ function wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,err if (has_wrappers) then !> Find a Fortran wrapper for the current compiler - wrap(WRAPPER_FORTRAN) = mpi_compiler_match(fort_wrappers,compiler,wrap_error) - wrap(WRAPPER_C ) = mpi_compiler_match(c_wrappers,compiler,wrap_error) - wrap(WRAPPER_CXX ) = mpi_compiler_match(cpp_wrappers,compiler,wrap_error) + call mpi_compiler_match(LANG_FORTRAN,fort_wrappers,compiler,wrap(LANG_FORTRAN),mpi(LANG_FORTRAN),wrap_error) + call mpi_compiler_match(LANG_C, c_wrappers,compiler,wrap(LANG_C),mpi(LANG_C),wrap_error) + call mpi_compiler_match(LANG_CXX, cpp_wrappers,compiler,wrap(LANG_CXX),mpi(LANG_CXX),wrap_error) if (all(wrap==0)) then call fatal_error(error,'no valid wrappers match current compiler, '//compiler_name(compiler)) @@ -508,7 +530,7 @@ function wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,err endif -end function wrapper_compiler_fit +end subroutine wrapper_compiler_fit !> Check if a local MS-MPI SDK build is found logical function msmpi_init(this,compiler,error) result(found) @@ -926,9 +948,10 @@ function get_dos_path(path,error) end function get_dos_path !> Initialize an MPI metapackage from a valid wrapper command ('mpif90', etc...) -subroutine init_mpi_from_wrappers(this,compiler,fort_wrapper,c_wrapper,cxx_wrapper,error) +subroutine init_mpi_from_wrappers(this,compiler,mpilib,fort_wrapper,c_wrapper,cxx_wrapper,error) class(metapackage_t), intent(inout) :: this type(compiler_t), intent(in) :: compiler + integer, intent(in) :: mpilib type(string_t), intent(in) :: fort_wrapper,c_wrapper,cxx_wrapper type(error_t), allocatable, intent(out) :: error @@ -938,23 +961,25 @@ subroutine init_mpi_from_wrappers(this,compiler,fort_wrapper,c_wrapper,cxx_wrapp call destroy(this) ! Get linking flags - this%link_flags = mpi_wrapper_query(fort_wrapper,'link',verbose,error) - if (allocated(error)) return - this%has_link_flags = len_trim(this%link_flags)>0 + if (mpilib/=MPI_TYPE_INTEL) then + this%link_flags = mpi_wrapper_query(mpilib,fort_wrapper,'link',verbose,error) + if (allocated(error)) return + this%has_link_flags = len_trim(this%link_flags)>0 + endif ! Add heading space - this%link_flags = string_t(' '//this%link_flags%s) + if (this%has_link_flags) this%link_flags = string_t(' '//this%link_flags%s) ! Add language-specific flags - call set_language_flags(fort_wrapper,this%has_fortran_flags,this%fflags,verbose,error) + call set_language_flags(mpilib,fort_wrapper,this%has_fortran_flags,this%fflags,verbose,error) if (allocated(error)) return - call set_language_flags(c_wrapper,this%has_c_flags,this%cflags,verbose,error) + call set_language_flags(mpilib,c_wrapper,this%has_c_flags,this%cflags,verbose,error) if (allocated(error)) return - call set_language_flags(cxx_wrapper,this%has_cxx_flags,this%cxxflags,verbose,error) + call set_language_flags(mpilib,cxx_wrapper,this%has_cxx_flags,this%cxxflags,verbose,error) if (allocated(error)) return ! Get library version - version = mpi_version_get(fort_wrapper,error) + version = mpi_version_get(mpilib,fort_wrapper,error) if (allocated(error)) then return else @@ -962,13 +987,14 @@ subroutine init_mpi_from_wrappers(this,compiler,fort_wrapper,c_wrapper,cxx_wrapp end if !> Add default run command, if present - this%run_command = mpi_wrapper_query(fort_wrapper,'runner',verbose,error) + this%run_command = mpi_wrapper_query(mpilib,fort_wrapper,'runner',verbose,error) if (allocated(error)) return this%has_run_command = len_trim(this%run_command)>0 contains - subroutine set_language_flags(wrapper,has_flags,flags,verbose,error) + subroutine set_language_flags(mpilib,wrapper,has_flags,flags,verbose,error) + integer, intent(in) :: mpilib type(string_t), intent(in) :: wrapper logical, intent(inout) :: has_flags type(string_t), intent(inout) :: flags @@ -977,7 +1003,7 @@ subroutine set_language_flags(wrapper,has_flags,flags,verbose,error) ! Get build flags for each language if (len_trim(wrapper)>0) then - flags = mpi_wrapper_query(wrapper,'flags',verbose,error) + flags = mpi_wrapper_query(mpilib,wrapper,'flags',verbose,error) if (allocated(error)) return has_flags = len_trim(flags)>0 @@ -994,9 +1020,11 @@ end subroutine set_language_flags end subroutine init_mpi_from_wrappers !> Match one of the available compiler wrappers with the current compiler -integer function mpi_compiler_match(wrappers,compiler,error) +subroutine mpi_compiler_match(language,wrappers,compiler,which_one,mpilib,error) + integer, intent(in) :: language type(string_t), intent(in) :: wrappers(:) type(compiler_t), intent(in) :: compiler + integer, intent(out) :: which_one, mpilib type(error_t), allocatable, intent(out) :: error integer :: i @@ -1004,23 +1032,44 @@ integer function mpi_compiler_match(wrappers,compiler,error) character(128) :: msg_out type(compiler_t) :: mpi_compiler - mpi_compiler_match = 0 + which_one = 0 + mpilib = MPI_TYPE_NONE do i=1,size(wrappers) - screen = mpi_wrapper_query(wrappers(i),'compiler',verbose=.false.,error=error) - if (allocated(error)) return - - ! Build compiler type - call new_compiler(mpi_compiler,screen%s,'','',echo=.true.,verbose=.true.) + print *, 'TEST WRAPPER '//wrappers(i)%s - ! Match found! - if (mpi_compiler%id == compiler%id) then + mpilib = which_mpi_library(wrappers(i),compiler,verbose=.false.) - mpi_compiler_match = i - return + screen = mpi_wrapper_query(mpilib,wrappers(i),'compiler',verbose=.false.,error=error) + if (allocated(error)) return - end if + print *, 'screen <'//screen%s//'> compiler ',compiler%fc + + + select case (language) + case (LANG_FORTRAN) + ! Build compiler type. The ID is created based on the Fortran name + call new_compiler(mpi_compiler,screen%s,'','',echo=.true.,verbose=.true.) + + ! Fortran match found! + if (mpi_compiler%id == compiler%id) then + which_one = i + return + end if + + case (LANG_C) + ! For other languages, we can only hope that the name matches the expected one + if (screen%s==compiler%cc) then + which_one = i + return + end if + case (LANG_CXX) + if (screen%s==compiler%cxx) then + which_one = i + return + end if + end select end do @@ -1029,17 +1078,18 @@ integer function mpi_compiler_match(wrappers,compiler,error) call fatal_error(error,trim(msg_out)) 1 format(' None out of ',i0,' valid MPI wrappers matches compiler ',a) -end function mpi_compiler_match +end subroutine mpi_compiler_match !> Return library version from the MPI wrapper command -type(version_t) function mpi_version_get(wrapper,error) +type(version_t) function mpi_version_get(mpilib,wrapper,error) + integer, intent(in) :: mpilib type(string_t), intent(in) :: wrapper type(error_t), allocatable, intent(out) :: error type(string_t) :: version_line ! Get version string - version_line = mpi_wrapper_query(wrapper,'version',error=error) + version_line = mpi_wrapper_query(mpilib,wrapper,'version',error=error) if (allocated(error)) return ! Wrap to object @@ -1074,13 +1124,14 @@ subroutine mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) fort_wrappers = [fort_wrappers,string_t('mpigfortran'),string_t('mpgfortran'),& string_t('mpig77'),string_t('mpg77')] - case (id_intel_classic_windows,id_intel_llvm_windows,& + case (id_intel_classic_windows,id_intel_llvm_windows, & id_intel_classic_nix,id_intel_classic_mac,id_intel_llvm_nix,id_intel_llvm_unknown) - c_wrappers = [c_wrappers,string_t(get_env('I_MPI_CC','mpiicc')),string_t('mpicl.bat')] - cpp_wrappers = [cpp_wrappers,string_t(get_env('I_MPI_CXX','mpiicpc')),string_t('mpicl.bat')] - fort_wrappers = [fort_wrappers,string_t(get_env('I_MPI_F90','mpiifort')),string_t('mpif77'),& - string_t('mpif90')] + print *, 'intel wrappers' + + c_wrappers = [string_t(get_env('I_MPI_CC','mpiicc'))] + cpp_wrappers = [string_t(get_env('I_MPI_CXX','mpiicpc'))] + fort_wrappers = [string_t(get_env('I_MPI_F90','mpiifort'))] case (id_pgi,id_nvhpc) @@ -1096,15 +1147,16 @@ subroutine mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) end select compiler_specific - call assert_mpi_wrappers(fort_wrappers) - call assert_mpi_wrappers(c_wrappers) - call assert_mpi_wrappers(cpp_wrappers) + call assert_mpi_wrappers(fort_wrappers,compiler) + call assert_mpi_wrappers(c_wrappers,compiler) + call assert_mpi_wrappers(cpp_wrappers,compiler) end subroutine mpi_wrappers !> Filter out invalid/unavailable mpi wrappers -subroutine assert_mpi_wrappers(wrappers,verbose) +subroutine assert_mpi_wrappers(wrappers,compiler,verbose) type(string_t), allocatable, intent(inout) :: wrappers(:) + type(compiler_t), intent(in) :: compiler logical, optional, intent(in) :: verbose integer :: i @@ -1113,7 +1165,8 @@ subroutine assert_mpi_wrappers(wrappers,verbose) allocate(works(size(wrappers))) do i=1,size(wrappers) - works(i) = which_mpi_library(wrappers(i),verbose) + print *, 'test wrapper <', wrappers(i)%s,'>' + works(i) = which_mpi_library(wrappers(i),compiler,verbose) end do ! Filter out non-working wrappers @@ -1154,7 +1207,7 @@ subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_outp end if ! Init command - command = wrapper%s + command = trim(wrapper%s) add_arguments: if (present(args)) then do iarg=1,size(args) @@ -1164,6 +1217,7 @@ subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_outp endif add_arguments if (echo_local) print *, '+ ', command + print *, '+ ', command ! Test command call execute_command_line(command//redirect_str,exitstat=stat,cmdstat=cmdstat) @@ -1202,18 +1256,26 @@ subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_outp end subroutine run_mpi_wrapper !> Get MPI library type from the wrapper command. Currently, only OpenMPI is supported -integer function which_mpi_library(wrapper,verbose) +integer function which_mpi_library(wrapper,compiler,verbose) type(string_t), intent(in) :: wrapper + type(compiler_t), intent(in) :: compiler logical, intent(in), optional :: verbose logical :: is_mpi_wrapper integer :: stat ! Run mpi wrapper first + print *, 'run wrapper ',wrapper%s call run_mpi_wrapper(wrapper,verbose=verbose,cmd_success=is_mpi_wrapper) if (is_mpi_wrapper) then + if (compiler%is_intel()) then + which_mpi_library = MPI_TYPE_INTEL + return + end if + + ! Init as currently unsupported library which_mpi_library = MPI_TYPE_NONE @@ -1244,7 +1306,8 @@ integer function which_mpi_library(wrapper,verbose) end function which_mpi_library !> Test if an MPI wrapper works -type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result(screen) +type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) result(screen) + integer, intent(in) :: mpilib type(string_t), intent(in) :: wrapper character(*), intent(in) :: command logical, intent(in), optional :: verbose @@ -1254,17 +1317,14 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( character(:), allocatable :: redirect_str,tokens(:) type(string_t) :: cmdstr type(compiler_t) :: mpi_compiler - integer :: stat,cmdstat,mpi,ire,length - - ! Get mpi type - mpi = which_mpi_library(wrapper,verbose) + integer :: stat,cmdstat,ire,length select case (command) ! Get MPI compiler name case ('compiler') - select case (mpi) + select case (mpilib) case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper @@ -1289,11 +1349,28 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( ! Take out the first command from the whole line call split(screen%s,tokens,delimiters=' ') - screen%s = tokens(1) + screen%s = trim(tokens(1)) + + case (MPI_TYPE_INTEL) + + ! -show returns the build command of this wrapper + call run_mpi_wrapper(wrapper,[string_t('-show')],verbose=verbose, & + exitcode=stat,cmd_success=success,screen_output=screen) + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local INTEL MPI library does not support -show') + return + end if + + ! Take out the first command from the whole line + call split(screen%s,tokens,delimiters=' ') + screen%s = trim(tokens(1)) + + print *, 'INTEL MPI compiler: ',screen%s case default - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) return end select @@ -1302,7 +1379,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( ! Get a list of additional compiler flags case ('flags') - select case (mpi) + select case (mpilib) case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper @@ -1336,9 +1413,29 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( screen%s = screen%s(len_trim(tokens(1))+1:) end if + case (MPI_TYPE_INTEL) + + call run_mpi_wrapper(wrapper,[string_t('-show')],verbose=verbose, & + exitcode=stat,cmd_success=success,screen_output=screen) + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local INTEL MPI library does not support -show') + return + end if + + ! MPICH reports the full command including the compiler name. Remove it if so + call remove_new_lines(screen) + call split(screen%s,tokens) + call new_compiler(mpi_compiler,tokens(1),tokens(1),tokens(1),echo=.false.,verbose=verbose) + + if (mpi_compiler%id/=id_unknown) then + ! Remove trailing compiler name + screen%s = screen%s(len_trim(tokens(1))+1:) + end if + case default - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) return end select @@ -1346,7 +1443,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( ! Get a list of additional linker flags case ('link') - select case (mpi) + select case (mpilib) case (MPI_TYPE_OPENMPI) ! --showme:link returns the linker command of this wrapper @@ -1382,7 +1479,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( case default - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) return end select @@ -1390,7 +1487,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( ! Get a list of MPI library directories case ('link_dirs') - select case (mpi) + select case (mpilib) case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper @@ -1412,7 +1509,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( ! Get a list of include directories for the MPI headers/modules case ('incl_dirs') - select case (mpi) + select case (mpilib) case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper @@ -1434,7 +1531,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( ! Retrieve library version case ('version') - select case (mpi) + select case (mpilib) case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper @@ -1500,9 +1597,40 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( end if + case (MPI_TYPE_INTEL) + + ! --showme:command returns the build command of this wrapper + call run_mpi_wrapper(wrapper,[string_t('-v')],verbose=verbose, & + exitcode=stat,cmd_success=success,screen_output=screen) + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local INTEL MPI library does not support -v') + return + else + call remove_new_lines(screen) + end if + + print *, 'version screen = ',screen%s + + ! Extract version + ire = regex(screen%s,'\d+\.\d+\.\d+',length=length) + + print *, 'ire = ',ire,' length=',length + + if (ire>0 .and. length>0) then + + ! Parse version into the object (this should always work) + screen%s = screen%s(ire:ire+length-1) + + else + + call syntax_error(error,'cannot retrieve INTEL MPI library version.') + + end if + case default - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) return end select @@ -1510,7 +1638,7 @@ type(string_t) function mpi_wrapper_query(wrapper,command,verbose,error) result( ! Get path to the MPI runner command case ('runner') - select case (mpi) + select case (mpilib) case (MPI_TYPE_OPENMPI,MPI_TYPE_MPICH,MPI_TYPE_MSMPI) call get_mpi_runner(screen,verbose,error) case default From ecc29164c035768f4fd5b031c881a80308b91eeb Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 27 Apr 2023 05:51:37 -0500 Subject: [PATCH 102/304] bump fortran-regex to 1.1.2 due to ifort issue --- fpm.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm.toml b/fpm.toml index c4a7e4fbbd..baf65056d6 100644 --- a/fpm.toml +++ b/fpm.toml @@ -15,7 +15,7 @@ toml-f.rev = "54686e45993f3a9a1d05d5c7419f39e7d5a4eb3f" M_CLI2.git = "https://github.com/urbanjost/M_CLI2.git" M_CLI2.rev = "7264878cdb1baff7323cc48596d829ccfe7751b8" fortran-regex.git = "https://github.com/perazz/fortran-regex" -fortran-regex.tag = "1.1.1" +fortran-regex.tag = "1.1.2" jonquil.git = "https://github.com/toml-f/jonquil" jonquil.rev = "05d30818bb12fb877226ce284b9a3a41b971a889" From f7387535a97a58833a27cebfe65ce8cebcc7ae44 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 27 Apr 2023 05:57:48 -0500 Subject: [PATCH 103/304] add 'runner' task --- src/fpm_meta.f90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index f246486dd4..614f34eded 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -794,10 +794,11 @@ subroutine get_mpi_runner(command,verbose,error) ! Try several commands do itri=1,size(try) - call find_command_location(trim(try(itri)),command%s,verbose=verbose,error=error) + call find_command_location(trim(try(itri)),command%s,verbose=.true.,error=error) + if (allocated(error)) cycle ! Success! - success = len_trim(command%s)>0 .and. .not.allocated(error) + success = len_trim(command%s) if (success) then command%s = join_path(command%s,trim(try(itri))) return @@ -1501,7 +1502,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) case default - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) return end select @@ -1523,7 +1524,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) case default - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) return end select @@ -1639,10 +1640,10 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) case ('runner') select case (mpilib) - case (MPI_TYPE_OPENMPI,MPI_TYPE_MPICH,MPI_TYPE_MSMPI) + case (MPI_TYPE_OPENMPI,MPI_TYPE_MPICH,MPI_TYPE_MSMPI,MPI_TYPE_INTEL) call get_mpi_runner(screen,verbose,error) case default - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' is not currently supported') + call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) return end select From 60a33a204367c396b4283966d597c5100506da6a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 27 Apr 2023 06:19:46 -0500 Subject: [PATCH 104/304] simplify compiler path search --- src/fpm_meta.f90 | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 614f34eded..c8f5509972 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -759,16 +759,19 @@ subroutine find_command_location(command,path,echo,verbose,error) return end if + print *, 'fullpath <'//fullpath//'>, command=<'//command//'>' + ! Extract path only length = index(fullpath,command,BACK=.true.) + print *, 'length=',length if (length<=0) then call fatal_error(error,'full path to command ('//command//') does not include command name') return elseif (length==1) then ! Compiler is in the current folder - call get_absolute_path('.',path,error) + path = '.' else - call get_absolute_path(fullpath(1:length-1),path,error) + path = fullpath(1:length-1) end if if (allocated(error)) return @@ -795,10 +798,16 @@ subroutine get_mpi_runner(command,verbose,error) ! Try several commands do itri=1,size(try) call find_command_location(trim(try(itri)),command%s,verbose=.true.,error=error) - if (allocated(error)) cycle + + if (allocated(error)) then + print *, 'error returned: ',error%message + cycle + end if + + print *, 'command = ',command%s ! Success! - success = len_trim(command%s) + success = len_trim(command%s)>0 if (success) then command%s = join_path(command%s,trim(try(itri))) return From c2d444b963fb8d073b0de8459fead4a1ecbdd4f5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 27 Apr 2023 07:13:06 -0500 Subject: [PATCH 105/304] remove compiler prefix for C, C++ --- src/fpm_meta.f90 | 36 +++++++++--------------------------- 1 file changed, 9 insertions(+), 27 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index c8f5509972..09932ba418 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1274,8 +1274,10 @@ integer function which_mpi_library(wrapper,compiler,verbose) logical :: is_mpi_wrapper integer :: stat + ! Init as currently unsupported library + which_mpi_library = MPI_TYPE_NONE + ! Run mpi wrapper first - print *, 'run wrapper ',wrapper%s call run_mpi_wrapper(wrapper,verbose=verbose,cmd_success=is_mpi_wrapper) if (is_mpi_wrapper) then @@ -1285,10 +1287,6 @@ integer function which_mpi_library(wrapper,compiler,verbose) return end if - - ! Init as currently unsupported library - which_mpi_library = MPI_TYPE_NONE - ! Attempt to decipher which library this wrapper comes from. ! OpenMPI responds to '--showme' calls @@ -1307,10 +1305,6 @@ integer function which_mpi_library(wrapper,compiler,verbose) return endif - else - - which_mpi_library = MPI_TYPE_NONE - end if end function which_mpi_library @@ -1416,12 +1410,8 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) ! MPICH reports the full command including the compiler name. Remove it if so call remove_new_lines(screen) call split(screen%s,tokens) - call new_compiler(mpi_compiler,tokens(1),tokens(1),tokens(1),echo=.false.,verbose=verbose) - - if (mpi_compiler%id/=id_unknown) then - ! Remove trailing compiler name - screen%s = screen%s(len_trim(tokens(1))+1:) - end if + ! Remove trailing compiler name + screen%s = screen%s(len_trim(tokens(1))+1:) case (MPI_TYPE_INTEL) @@ -1436,12 +1426,8 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) ! MPICH reports the full command including the compiler name. Remove it if so call remove_new_lines(screen) call split(screen%s,tokens) - call new_compiler(mpi_compiler,tokens(1),tokens(1),tokens(1),echo=.false.,verbose=verbose) - - if (mpi_compiler%id/=id_unknown) then - ! Remove trailing compiler name - screen%s = screen%s(len_trim(tokens(1))+1:) - end if + ! Remove trailing compiler name + screen%s = screen%s(len_trim(tokens(1))+1:) case default @@ -1480,12 +1466,8 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) ! MPICH reports the full command including the compiler name. Remove it if so call remove_new_lines(screen) call split(screen%s,tokens) - call new_compiler(mpi_compiler,tokens(1),tokens(1),tokens(1),echo=.false.,verbose=verbose) - - if (mpi_compiler%id/=id_unknown) then - ! Remove trailing compiler name - screen%s = screen%s(len_trim(tokens(1))+1:) - end if + ! Remove trailing compiler name + screen%s = screen%s(len_trim(tokens(1))+1:) case default From 1cad824f4612e585ed58aeb30002470d00e4bfc7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 27 Apr 2023 08:00:17 -0500 Subject: [PATCH 106/304] fix linker flags for ifort with c/c++ main program --- .../metapackage_mpi_cpp/app/main.cpp | 2 +- src/fpm_targets.f90 | 67 +++++++++++++------ 2 files changed, 47 insertions(+), 22 deletions(-) diff --git a/example_packages/metapackage_mpi_cpp/app/main.cpp b/example_packages/metapackage_mpi_cpp/app/main.cpp index 8203285a9e..45abe795a2 100644 --- a/example_packages/metapackage_mpi_cpp/app/main.cpp +++ b/example_packages/metapackage_mpi_cpp/app/main.cpp @@ -1,6 +1,6 @@ // Test MPI linking from a C main program -#include #include +#include using namespace std; diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index ddd34cd7d4..d04b5859b5 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -146,7 +146,7 @@ subroutine targets_from_sources(targets,model,prune,error) !> Enable tree-shaking/pruning of module dependencies logical, intent(in) :: prune - + !> Error structure type(error_t), intent(out), allocatable :: error @@ -240,14 +240,14 @@ subroutine build_target_list(targets,model) features = model%packages(j)%features, & macros = model%packages(j)%macros, & version = model%packages(j)%version) - + if (with_lib .and. sources(i)%unit_scope == FPM_SCOPE_LIB) then ! Archive depends on object call add_dependency(targets(1)%ptr, targets(size(targets))%ptr) end if - case (FPM_UNIT_CPPSOURCE) + case (FPM_UNIT_CPPSOURCE) call add_target(targets,package=model%packages(j)%name,source = sources(i), & type = FPM_TARGET_CPP_OBJECT, & @@ -307,6 +307,18 @@ subroutine build_target_list(targets,model) output_name = join_path(exe_dir, & sources(i)%exe_name//xsuffix)) + + ! If the main program is on a C/C++ source, the Intel Fortran compiler requires option + ! -nofor-main to avoid "duplicate main" errors. + ! https://stackoverflow.com/questions/36221612/p3dfft-compilation-ifort-compiler-error-multiple-definiton-of-main + if (model%compiler%is_intel() .and. any(exe_type==[FPM_TARGET_C_OBJECT,FPM_TARGET_CPP_OBJECT])) then + if (get_os_type()==OS_WINDOWS) then + targets(size(targets))%ptr%compile_flags = '/nofor-main' + else + targets(size(targets))%ptr%compile_flags = '-nofor-main' + end if + end if + ! Executable depends on object call add_dependency(targets(size(targets))%ptr, targets(size(targets)-1)%ptr) @@ -385,7 +397,7 @@ subroutine collect_exe_link_dependencies(targets) dep%source%unit_type /= FPM_UNIT_MODULE .and. & index(dirname(dep%source%file_name), exe_source_dir) == 1) then - call add_dependency(exe, dep) + call add_dependency(exe, dep) end if @@ -583,13 +595,13 @@ subroutine prune_build_targets(targets, root_package) type(build_target_ptr), intent(inout), allocatable :: targets(:) !> Name of root package - character(*), intent(in) :: root_package + character(*), intent(in) :: root_package integer :: i, j, nexec type(string_t), allocatable :: modules_used(:) logical :: exclude_target(size(targets)) logical, allocatable :: exclude_from_archive(:) - + if (size(targets) < 1) then return end if @@ -599,7 +611,7 @@ subroutine prune_build_targets(targets, root_package) ! Enumerate modules used by executables, non-module subprograms and their dependencies do i=1,size(targets) - + if (targets(i)%ptr%target_type == FPM_TARGET_EXECUTABLE) then nexec = nexec + 1 @@ -620,16 +632,16 @@ subroutine prune_build_targets(targets, root_package) ! If there aren't any executables, then prune ! based on modules used in root package if (nexec < 1) then - + do i=1,size(targets) - + if (targets(i)%ptr%package_name == root_package .and. & targets(i)%ptr%target_type /= FPM_TARGET_ARCHIVE) then - + call collect_used_modules(targets(i)%ptr) - + end if - + end do end if @@ -651,11 +663,11 @@ subroutine prune_build_targets(targets, root_package) do j=1,size(target%source%modules_provided) if (target%source%modules_provided(j)%s .in. modules_used) then - + exclude_target(i) = .false. target%skip = .false. - end if + end if end do @@ -667,11 +679,11 @@ subroutine prune_build_targets(targets, root_package) do j=1,size(target%source%parent_modules) if (target%source%parent_modules(j)%s .in. modules_used) then - + exclude_target(i) = .false. target%skip = .false. - end if + end if end do @@ -684,7 +696,7 @@ subroutine prune_build_targets(targets, root_package) target%skip = .false. end if - end associate + end associate end do targets = pack(targets,.not.exclude_target) @@ -809,20 +821,33 @@ subroutine resolve_target_linking(targets, model) do i=1,size(targets) associate(target => targets(i)%ptr) + + ! May have been previously allocated + if (.not.allocated(target%compile_flags)) allocate(character(len=0) :: target%compile_flags) + + target%compile_flags = target%compile_flags//' ' + if (target%target_type /= FPM_TARGET_C_OBJECT .and. target%target_type /= FPM_TARGET_CPP_OBJECT) then - target%compile_flags = model%fortran_compile_flags & + target%compile_flags = target%compile_flags//model%fortran_compile_flags & & // get_feature_flags(model%compiler, target%features) else if (target%target_type == FPM_TARGET_C_OBJECT) then - target%compile_flags = model%c_compile_flags + target%compile_flags = target%compile_flags//model%c_compile_flags else if(target%target_type == FPM_TARGET_CPP_OBJECT) then - target%compile_flags = model%cxx_compile_flags + target%compile_flags = target%compile_flags//model%cxx_compile_flags + end if + + ! If the main program is a C/C++ one, Intel compilers require additional + ! linking flag -nofor-main to avoid a "duplicate main" error, see + ! https://stackoverflow.com/questions/36221612/p3dfft-compilation-ifort-compiler-error-multiple-definiton-of-main + if (model%compiler%is_intel() .and. target%target_type==FPM_TARGET_EXECUTABLE) then + print *, 'target compile flags ',target%compile_flags end if !> Get macros as flags. target%compile_flags = target%compile_flags // get_macros(model%compiler%id, & target%macros, & target%version) - + if (len(global_include_flags) > 0) then target%compile_flags = target%compile_flags//global_include_flags end if From f6e93ec50e4b159ecf86a9aabcbc8ca8a1322875 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 27 Apr 2023 18:00:20 +0200 Subject: [PATCH 107/304] introduce ubuntu+intelmpi --- .github/workflows/meta.yml | 19 ++++++++++++++++++- src/fpm_meta.f90 | 29 +++++++++++------------------ 2 files changed, 29 insertions(+), 19 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 9e99df547f..de013716ed 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -28,9 +28,11 @@ jobs: fail-fast: false matrix: os: [macos-11,windows-latest,ubuntu-latest] - mpi: [mpich,openmpi,msmpi] + mpi: [mpich,openmpi,msmpi,intel] gcc_v: [10] # Version of GFortran we want to use exclude: + - os: macos-11 + mpi: intel - os: macos-11 mpi: msmpi - os: macos-11 # temporary @@ -41,8 +43,16 @@ jobs: mpi: msmpi - os: windows-latest mpi: mpich + - os: windows-latest + mpi: intel - os: windows-latest mpi: openmpi + - os: ubuntu-latest + mpi: openmpi + - os: ubuntu-latest + mpi: mpich + - os: ubuntu-latest + mpi: msmpi include: - os: macos-11 os-arch: macos-x86_64 @@ -73,6 +83,13 @@ jobs: curl gcc-fortran + - name: (Ubuntu) Install INTEL MPI toolchain + if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') + uses: awvwgk/setup-fortran@v1 + with: + compiler: intel-classic + version: 2021.8 + - name: (Windows) Put MSYS2_MinGW64 on PATH if: contains(matrix.os,'windows') # there is not yet an environment variable for this path from msys2/setup-msys2 diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 09932ba418..302ca0796a 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -440,19 +440,13 @@ subroutine init_mpi(this,compiler,error) !> Cleanup call destroy(this) - print *, 'init wrappers' !> Get all candidate MPI wrappers call mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) if (verbose) print 1, size(fort_wrappers),size(c_wrappers),size(cpp_wrappers) - print *, 'wrapper compiler fit' - call wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,wcfit,mpilib,error) - print *, 'wcfit = ',wcfit - print *, 'mpilib = ',mpilib - if (allocated(error) .or. all(wcfit==0)) then !> No wrapper compiler fit. Are we on Windows? use MSMPI-specific search @@ -471,8 +465,6 @@ subroutine init_mpi(this,compiler,error) if (wcfit(LANG_C)>0) cwrap = c_wrappers (wcfit(LANG_C)) if (wcfit(LANG_CXX)>0) cxxwrap = cpp_wrappers (wcfit(LANG_CXX)) - print *, 'wcfit' - !> If there's only an available Fortran wrapper, and the compiler's different than fpm's baseline !> fortran compiler suite, we still want to enable C language flags as that is most likely being !> ABI-compatible anyways. However, issues may arise. @@ -516,19 +508,20 @@ subroutine wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,w !> Were any wrappers found? has_wrappers = size(fort_wrappers)*size(c_wrappers)*size(cpp_wrappers)>0 - if (has_wrappers) then + if (size(fort_wrappers)>0) & + call mpi_compiler_match(LANG_FORTRAN,fort_wrappers,compiler,wrap(LANG_FORTRAN),mpi(LANG_FORTRAN),wrap_error) - !> Find a Fortran wrapper for the current compiler - call mpi_compiler_match(LANG_FORTRAN,fort_wrappers,compiler,wrap(LANG_FORTRAN),mpi(LANG_FORTRAN),wrap_error) - call mpi_compiler_match(LANG_C, c_wrappers,compiler,wrap(LANG_C),mpi(LANG_C),wrap_error) - call mpi_compiler_match(LANG_CXX, cpp_wrappers,compiler,wrap(LANG_CXX),mpi(LANG_CXX),wrap_error) + if (size(c_wrappers)>0) & + call mpi_compiler_match(LANG_C,c_wrappers,compiler,wrap(LANG_C),mpi(LANG_C),wrap_error) - if (all(wrap==0)) then - call fatal_error(error,'no valid wrappers match current compiler, '//compiler_name(compiler)) - return - end if + if (size(cpp_wrappers)>0) & + call mpi_compiler_match(LANG_CXX,cpp_wrappers,compiler,wrap(LANG_CXX),mpi(LANG_CXX),wrap_error) - endif + !> Find a Fortran wrapper for the current compiler + if (all(wrap==0)) then + call fatal_error(error,'no valid wrappers match current compiler, '//compiler_name(compiler)) + return + end if end subroutine wrapper_compiler_fit From 13850e677013598f5087ca370c7c12401275e87a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 27 Apr 2023 18:23:31 +0200 Subject: [PATCH 108/304] install mpi sdk --- .github/workflows/meta.yml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index de013716ed..a1903cef2d 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -83,13 +83,18 @@ jobs: curl gcc-fortran - - name: (Ubuntu) Install INTEL MPI toolchain + - name: (Ubuntu) Install Intel toolchain if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') uses: awvwgk/setup-fortran@v1 with: compiler: intel-classic version: 2021.8 + - name: (Ubuntu) Install MPI SDK + if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') + run: DEBIAN_FRONTEND=noninteractive apt-get install -y --no-install-recommends ca-certificates build-essential pkg-config gnupg libarchive13 openssh-server openssh-client wget net-tools git intel-basekit-getting-started intel-oneapi-advisor intel-oneapi-ccl-devel intel-oneapi-common-licensing intel-oneapi-common-vars intel-oneapi-compiler-dpcpp-cpp intel-oneapi-dal-devel intel-oneapi-dev-utilities intel-oneapi-dnnl-devel intel-oneapi-dpcpp-debugger intel-oneapi-ipp-devel intel-oneapi-ippcp-devel intel-oneapi-libdpstd-devel intel-oneapi-mkl-devel intel-oneapi-tbb-devel intel-oneapi-vtune intel-level-zero-gpu level-zero intel-hpckit-getting-started intel-oneapi-clck intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic intel-oneapi-compiler-fortran intel-oneapi-inspector intel-oneapi-itac intel-oneapi-mpi-devel + + - name: (Windows) Put MSYS2_MinGW64 on PATH if: contains(matrix.os,'windows') # there is not yet an environment variable for this path from msys2/setup-msys2 From f2aec4b9460f26133becb5386ecd2a06cc904f9c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 27 Apr 2023 18:28:37 +0200 Subject: [PATCH 109/304] install as sudo --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index a1903cef2d..c324cd0e44 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -92,7 +92,7 @@ jobs: - name: (Ubuntu) Install MPI SDK if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') - run: DEBIAN_FRONTEND=noninteractive apt-get install -y --no-install-recommends ca-certificates build-essential pkg-config gnupg libarchive13 openssh-server openssh-client wget net-tools git intel-basekit-getting-started intel-oneapi-advisor intel-oneapi-ccl-devel intel-oneapi-common-licensing intel-oneapi-common-vars intel-oneapi-compiler-dpcpp-cpp intel-oneapi-dal-devel intel-oneapi-dev-utilities intel-oneapi-dnnl-devel intel-oneapi-dpcpp-debugger intel-oneapi-ipp-devel intel-oneapi-ippcp-devel intel-oneapi-libdpstd-devel intel-oneapi-mkl-devel intel-oneapi-tbb-devel intel-oneapi-vtune intel-level-zero-gpu level-zero intel-hpckit-getting-started intel-oneapi-clck intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic intel-oneapi-compiler-fortran intel-oneapi-inspector intel-oneapi-itac intel-oneapi-mpi-devel + run: DEBIAN_FRONTEND=noninteractive sudo apt-get install -y --no-install-recommends ca-certificates build-essential pkg-config gnupg libarchive13 openssh-server openssh-client wget net-tools git intel-basekit-getting-started intel-oneapi-advisor intel-oneapi-ccl-devel intel-oneapi-common-licensing intel-oneapi-common-vars intel-oneapi-compiler-dpcpp-cpp intel-oneapi-dal-devel intel-oneapi-dev-utilities intel-oneapi-dnnl-devel intel-oneapi-dpcpp-debugger intel-oneapi-ipp-devel intel-oneapi-ippcp-devel intel-oneapi-libdpstd-devel intel-oneapi-mkl-devel intel-oneapi-tbb-devel intel-oneapi-vtune intel-level-zero-gpu level-zero intel-hpckit-getting-started intel-oneapi-clck intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic intel-oneapi-compiler-fortran intel-oneapi-inspector intel-oneapi-itac intel-oneapi-mpi-devel - name: (Windows) Put MSYS2_MinGW64 on PATH From 9b87b080f455ad8adb9371d5aea516644cc50a06 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 10:37:00 +0200 Subject: [PATCH 110/304] use Intel Classic action --- .github/workflows/meta.yml | 5 ----- 1 file changed, 5 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index c324cd0e44..714f34e97c 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -90,11 +90,6 @@ jobs: compiler: intel-classic version: 2021.8 - - name: (Ubuntu) Install MPI SDK - if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') - run: DEBIAN_FRONTEND=noninteractive sudo apt-get install -y --no-install-recommends ca-certificates build-essential pkg-config gnupg libarchive13 openssh-server openssh-client wget net-tools git intel-basekit-getting-started intel-oneapi-advisor intel-oneapi-ccl-devel intel-oneapi-common-licensing intel-oneapi-common-vars intel-oneapi-compiler-dpcpp-cpp intel-oneapi-dal-devel intel-oneapi-dev-utilities intel-oneapi-dnnl-devel intel-oneapi-dpcpp-debugger intel-oneapi-ipp-devel intel-oneapi-ippcp-devel intel-oneapi-libdpstd-devel intel-oneapi-mkl-devel intel-oneapi-tbb-devel intel-oneapi-vtune intel-level-zero-gpu level-zero intel-hpckit-getting-started intel-oneapi-clck intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic intel-oneapi-compiler-fortran intel-oneapi-inspector intel-oneapi-itac intel-oneapi-mpi-devel - - - name: (Windows) Put MSYS2_MinGW64 on PATH if: contains(matrix.os,'windows') # there is not yet an environment variable for this path from msys2/setup-msys2 From a319e80553d40e5e089e5be39252e82c55ebaa79 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 10:53:00 +0200 Subject: [PATCH 111/304] use ifort compiler --- .github/workflows/meta.yml | 72 ++++++++++++++++++-------------------- 1 file changed, 35 insertions(+), 37 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 714f34e97c..7894519a90 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -27,44 +27,42 @@ jobs: strategy: fail-fast: false matrix: - os: [macos-11,windows-latest,ubuntu-latest] - mpi: [mpich,openmpi,msmpi,intel] - gcc_v: [10] # Version of GFortran we want to use - exclude: - - os: macos-11 - mpi: intel - - os: macos-11 - mpi: msmpi - - os: macos-11 # temporary - mpi: openmpi - - os: macos-11 # temporary - mpi: mpich - - os: windows-latest # temporary - mpi: msmpi - - os: windows-latest - mpi: mpich - - os: windows-latest - mpi: intel - - os: windows-latest - mpi: openmpi - - os: ubuntu-latest - mpi: openmpi - - os: ubuntu-latest - mpi: mpich - - os: ubuntu-latest - mpi: msmpi include: - - os: macos-11 - os-arch: macos-x86_64 - release-flags: --flag '-g -fbacktrace -O3' - - os: windows-latest - os-arch: windows-x86_64 - release-flags: --flag '--static -g -fbacktrace -O3' - exe: .exe - - env: - FC: gfortran - GCC_V: ${{ matrix.gcc_v }} + - os: ubuntu-latest + mpi: intel + env: + FC: ifort + FPM_FC: ifort + # os: [macos-11,windows-latest,ubuntu-latest] + #mpi: [mpich,openmpi,msmpi,intel] + #gcc_v: [10] # Version of GFortran we want to use + #exclude: + #- os: macos-11 + # mpi: intel + #- os: macos-11 + # mpi: msmpi + #- os: macos-11 # temporary + # mpi: openmpi + #- os: macos-11 # temporary + # mpi: mpich + #- os: windows-latest # temporary + # mpi: msmpi + #- os: windows-latest + # mpi: mpich + #- os: windows-latest + # mpi: intel + #- os: windows-latest + # mpi: openmpi + #- os: ubuntu-latest + # mpi: openmpi + #- os: ubuntu-latest + # mpi: mpich + #- os: ubuntu-latest + # mpi: msmpi + + # env: + # FC: gfortran + # GCC_V: ${{ matrix.gcc_v }} steps: - name: Checkout code From 557b5f7878718e8fd1d2cef9d1f590f0fab04158 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 11:02:26 +0200 Subject: [PATCH 112/304] export custom compiler via `FPM_FC` --- .github/workflows/meta.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 7894519a90..f691a57ec8 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -227,5 +227,6 @@ jobs: - name: Run metapackage tests using the release version shell: bash run: | + FPM_FC=${{ env.FPM_FC }} ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" From 0eb4f7f79df6befc2f1f116f209f2a1977c98f01 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 11:16:09 +0200 Subject: [PATCH 113/304] Update meta.yml --- .github/workflows/meta.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index f691a57ec8..3aa91adde6 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -227,6 +227,7 @@ jobs: - name: Run metapackage tests using the release version shell: bash run: | - FPM_FC=${{ env.FPM_FC }} + echo "FPM_FC=${{ env.FPM_FC }}" >> $GITHUB_ENV + echo "using compiler $FPM_FC" ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" From 049918505bd6e7ae00b65f07442329bf9cf5c75a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 11:27:05 +0200 Subject: [PATCH 114/304] Update meta.yml --- .github/workflows/meta.yml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 3aa91adde6..b132b200ce 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -30,9 +30,7 @@ jobs: include: - os: ubuntu-latest mpi: intel - env: - FC: ifort - FPM_FC: ifort + FPM_FC: ifort # os: [macos-11,windows-latest,ubuntu-latest] #mpi: [mpich,openmpi,msmpi,intel] #gcc_v: [10] # Version of GFortran we want to use @@ -227,7 +225,7 @@ jobs: - name: Run metapackage tests using the release version shell: bash run: | - echo "FPM_FC=${{ env.FPM_FC }}" >> $GITHUB_ENV + echo "FPM_FC=${{ matrix.FPM_FC }}" >> $GITHUB_ENV echo "using compiler $FPM_FC" ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" From cd3dd0188ff7aec2599ea6a4f5dbcf7ad18078e9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 11:33:42 +0200 Subject: [PATCH 115/304] local env --- .github/workflows/meta.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index b132b200ce..7cd905a35c 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -226,6 +226,7 @@ jobs: shell: bash run: | echo "FPM_FC=${{ matrix.FPM_FC }}" >> $GITHUB_ENV + FPM_FC=${{ matrix.FPM_FC }} echo "using compiler $FPM_FC" ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" From 9feec04b8b7e91022f46b53bee3461a1513e5140 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 11:37:28 +0200 Subject: [PATCH 116/304] Update meta.yml --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 7cd905a35c..2c3b92ff05 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -226,7 +226,7 @@ jobs: shell: bash run: | echo "FPM_FC=${{ matrix.FPM_FC }}" >> $GITHUB_ENV - FPM_FC=${{ matrix.FPM_FC }} + FPM_FC="${{ env.FPM_FC }}" echo "using compiler $FPM_FC" ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" From c17c3ff58c0be406998dc72e068ec52b020bc37a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 11:43:19 +0200 Subject: [PATCH 117/304] Update meta.yml --- .github/workflows/meta.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 2c3b92ff05..8795cbaec6 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -226,7 +226,7 @@ jobs: shell: bash run: | echo "FPM_FC=${{ matrix.FPM_FC }}" >> $GITHUB_ENV - FPM_FC="${{ env.FPM_FC }}" - echo "using compiler $FPM_FC" + FPM_FC=$(echo ${{ env.FPM_FC }}) + echo "using compiler $FPM_FC " ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" From a5ba91728415c050ff50905729c042bf2bf141d8 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 11:51:29 +0200 Subject: [PATCH 118/304] Update meta.yml --- .github/workflows/meta.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 8795cbaec6..37eaa27c00 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -225,8 +225,7 @@ jobs: - name: Run metapackage tests using the release version shell: bash run: | - echo "FPM_FC=${{ matrix.FPM_FC }}" >> $GITHUB_ENV - FPM_FC=$(echo ${{ env.FPM_FC }}) + FPM_FC=$(echo ${{ matrix.FPM_FC }}) echo "using compiler $FPM_FC " ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" From 0e24c344371bc57c9d7efef7180bbd596af11ddd Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 12:03:12 +0200 Subject: [PATCH 119/304] use $FC --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 37eaa27c00..7326b362e7 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -225,7 +225,7 @@ jobs: - name: Run metapackage tests using the release version shell: bash run: | - FPM_FC=$(echo ${{ matrix.FPM_FC }}) + FPM_FC=$(echo ${{ env.FC }}) echo "using compiler $FPM_FC " ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" From 1269d72b71733aa65174a33d465c1446a46b0539 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 12:19:07 +0200 Subject: [PATCH 120/304] Update meta.yml --- .github/workflows/meta.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 7326b362e7..b744d7e1c0 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -30,7 +30,6 @@ jobs: include: - os: ubuntu-latest mpi: intel - FPM_FC: ifort # os: [macos-11,windows-latest,ubuntu-latest] #mpi: [mpich,openmpi,msmpi,intel] #gcc_v: [10] # Version of GFortran we want to use @@ -225,7 +224,8 @@ jobs: - name: Run metapackage tests using the release version shell: bash run: | - FPM_FC=$(echo ${{ env.FC }}) echo "using compiler $FPM_FC " ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" + env: + FPM_FC : ${{ env.FC }} From 20a3416d47aed469fcfed92335c07e8cb3411671 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 12:49:23 +0200 Subject: [PATCH 121/304] export all intel vars --- .github/workflows/meta.yml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index b744d7e1c0..013c9f86fc 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -85,6 +85,12 @@ jobs: compiler: intel-classic version: 2021.8 + - name: (Ubuntu) Setup Intel oneAPI environment + if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') + run: | + source /opt/intel/oneapi/setvars.sh + printenv >> $GITHUB_ENV + - name: (Windows) Put MSYS2_MinGW64 on PATH if: contains(matrix.os,'windows') # there is not yet an environment variable for this path from msys2/setup-msys2 From b426f3430f6d82f8a4a412834a5340d3dd3a7454 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 07:33:06 -0500 Subject: [PATCH 122/304] IntelMPI: enable search via `I_MPI_ROOT` --- src/fpm_meta.f90 | 63 ++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 53 insertions(+), 10 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 302ca0796a..e4807aeaed 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -95,7 +95,7 @@ module fpm_meta public :: MPI_TYPE_NAME !> Debugging information -logical, parameter, private :: verbose = .false. +logical, parameter, private :: verbose = .true. integer, parameter, private :: LANG_FORTRAN = 1 integer, parameter, private :: LANG_C = 2 @@ -474,6 +474,9 @@ subroutine init_mpi(this,compiler,error) cxxwrap = fort_wrappers(wcfit(LANG_FORTRAN)) end if + print *, 'wcfit = ',wcfit + print *, 'mpilib = ',mpilib + !> Initialize MPI package from wrapper command call init_mpi_from_wrappers(this,compiler,mpilib(LANG_FORTRAN),fwrap,cwrap,cxxwrap,error) if (allocated(error)) return @@ -499,15 +502,11 @@ subroutine wrapper_compiler_fit(fort_wrappers,c_wrappers,cpp_wrappers,compiler,w type(error_t), allocatable, intent(out) :: error integer, intent(out), dimension(3) :: wrap, mpi - logical :: has_wrappers type(error_t), allocatable :: wrap_error wrap = 0 mpi = MPI_TYPE_NONE - !> Were any wrappers found? - has_wrappers = size(fort_wrappers)*size(c_wrappers)*size(cpp_wrappers)>0 - if (size(fort_wrappers)>0) & call mpi_compiler_match(LANG_FORTRAN,fort_wrappers,compiler,wrap(LANG_FORTRAN),mpi(LANG_FORTRAN),wrap_error) @@ -1047,7 +1046,7 @@ subroutine mpi_compiler_match(language,wrappers,compiler,which_one,mpilib,error) screen = mpi_wrapper_query(mpilib,wrappers(i),'compiler',verbose=.false.,error=error) if (allocated(error)) return - print *, 'screen <'//screen%s//'> compiler ',compiler%fc + print *, 'screen <'//screen%s//'> compiler ',compiler%fc,' language = ',language select case (language) @@ -1063,12 +1062,12 @@ subroutine mpi_compiler_match(language,wrappers,compiler,which_one,mpilib,error) case (LANG_C) ! For other languages, we can only hope that the name matches the expected one - if (screen%s==compiler%cc) then + if (screen%s==compiler%cc .or. screen%s==compiler%fc) then which_one = i return end if case (LANG_CXX) - if (screen%s==compiler%cxx) then + if (screen%s==compiler%cxx .or. screen%s==compiler%fc) then which_one = i return end if @@ -1105,6 +1104,9 @@ subroutine mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) type(compiler_t), intent(in) :: compiler type(string_t), allocatable, intent(out) :: c_wrappers(:),cpp_wrappers(:),fort_wrappers(:) + character(len=:), allocatable :: mpi_root,intel_wrap + type(error_t), allocatable :: error + ! Attempt gathering MPI wrapper names from the environment variables c_wrappers = [string_t(get_env('MPICC' ,'mpicc'))] cpp_wrappers = [string_t(get_env('MPICXX','mpic++'))] @@ -1130,12 +1132,38 @@ subroutine mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) case (id_intel_classic_windows,id_intel_llvm_windows, & id_intel_classic_nix,id_intel_classic_mac,id_intel_llvm_nix,id_intel_llvm_unknown) - print *, 'intel wrappers' - c_wrappers = [string_t(get_env('I_MPI_CC','mpiicc'))] cpp_wrappers = [string_t(get_env('I_MPI_CXX','mpiicpc'))] fort_wrappers = [string_t(get_env('I_MPI_F90','mpiifort'))] + ! temporary + deallocate(c_wrappers,cpp_wrappers,fort_wrappers) + allocate(c_wrappers(0),cpp_wrappers(0),fort_wrappers(0)) + + ! It is possible that + mpi_root = get_env('I_MPI_ROOT') + + if (mpi_root/="") then + + mpi_root = join_path(mpi_root,'bin') + + print *, 'mpi_root',mpi_root + + intel_wrap = join_path(mpi_root,'mpiifort') + if (get_os_type()==OS_WINDOWS) intel_wrap = get_dos_path(intel_wrap,error) + if (intel_wrap/="") fort_wrappers = [fort_wrappers,string_t(intel_wrap)] + + intel_wrap = join_path(mpi_root,'mpiicc') + if (get_os_type()==OS_WINDOWS) intel_wrap = get_dos_path(intel_wrap,error) + if (intel_wrap/="") c_wrappers = [c_wrappers,string_t(intel_wrap)] + + intel_wrap = join_path(mpi_root,'mpiicpc') + if (get_os_type()==OS_WINDOWS) intel_wrap = get_dos_path(intel_wrap,error) + if (intel_wrap/="") cpp_wrappers = [cpp_wrappers,string_t(intel_wrap)] + + end if + + case (id_pgi,id_nvhpc) c_wrappers = [c_wrappers,string_t('mpipgicc'),string_t('mpgcc')] @@ -1209,6 +1237,15 @@ subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_outp end if end if + ! Empty command + if (len_trim(wrapper)<=0) then + if (verbose) print *, '+ ' + if (present(exitcode)) exitcode = 0 + if (present(cmd_success)) cmd_success = .true. + if (present(screen_output)) screen_output = string_t("") + return + end if + ! Init command command = trim(wrapper%s) @@ -1270,9 +1307,15 @@ integer function which_mpi_library(wrapper,compiler,verbose) ! Init as currently unsupported library which_mpi_library = MPI_TYPE_NONE + print *, 'len_trim= ',len_trim(wrapper) + + if (len_trim(wrapper)<=0) return + ! Run mpi wrapper first call run_mpi_wrapper(wrapper,verbose=verbose,cmd_success=is_mpi_wrapper) + print *, 'is_mpi_wrapper=',is_mpi_wrapper,' wrapper = ',wrapper%s + if (is_mpi_wrapper) then if (compiler%is_intel()) then From 1330d84b97301585204313124a16fe1d68344c88 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 07:42:49 -0500 Subject: [PATCH 123/304] use standard Intel compiler --- .github/workflows/meta.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 013c9f86fc..c0a9897e6d 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -82,8 +82,8 @@ jobs: if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') uses: awvwgk/setup-fortran@v1 with: - compiler: intel-classic - version: 2021.8 + compiler: intel + version: 2023.0 - name: (Ubuntu) Setup Intel oneAPI environment if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') From 20d0b30f48e3489102860ec5f15314344c42bab6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 07:45:01 -0500 Subject: [PATCH 124/304] intel-classic 2023.0 --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index c0a9897e6d..35f6dc2284 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -82,7 +82,7 @@ jobs: if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') uses: awvwgk/setup-fortran@v1 with: - compiler: intel + compiler: intel-classic version: 2023.0 - name: (Ubuntu) Setup Intel oneAPI environment From b4032642f11a9d798b4b9f084ce66fa67d89e05e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 07:48:05 -0500 Subject: [PATCH 125/304] 2022.0.2 --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 35f6dc2284..ffe3ea1b8d 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -83,7 +83,7 @@ jobs: uses: awvwgk/setup-fortran@v1 with: compiler: intel-classic - version: 2023.0 + version: 2022.0.2 - name: (Ubuntu) Setup Intel oneAPI environment if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') From 3d539e1b507563094af8c791e7a9204911776618 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 07:57:14 -0500 Subject: [PATCH 126/304] 2021.1.1 --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index ffe3ea1b8d..9c31cb40f3 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -83,7 +83,7 @@ jobs: uses: awvwgk/setup-fortran@v1 with: compiler: intel-classic - version: 2022.0.2 + version: 2021.1.1 - name: (Ubuntu) Setup Intel oneAPI environment if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') From ef57e4f4a20f588eea37b49af78b7a9ae10d29e6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 08:10:18 -0500 Subject: [PATCH 127/304] install mpi --- .github/workflows/meta.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 9c31cb40f3..52eb636f3e 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -88,6 +88,7 @@ jobs: - name: (Ubuntu) Setup Intel oneAPI environment if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') run: | + apt-get install intel-oneapi-mpi-2021.1.1 intel-oneapi-mpi-2021.1.1 source /opt/intel/oneapi/setvars.sh printenv >> $GITHUB_ENV From eb02be505b4fa339ea29f1f277b4f813b4b71739 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 08:19:09 -0500 Subject: [PATCH 128/304] install mpi as sudo --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 52eb636f3e..040369870c 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -88,7 +88,7 @@ jobs: - name: (Ubuntu) Setup Intel oneAPI environment if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') run: | - apt-get install intel-oneapi-mpi-2021.1.1 intel-oneapi-mpi-2021.1.1 + sudo apt-get install intel-oneapi-mpi-2021.1.1 intel-oneapi-mpi-2021.1.1 source /opt/intel/oneapi/setvars.sh printenv >> $GITHUB_ENV From 9c8ff2f8e5e31a18990a5581056a25819c62d7d3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 08:27:36 -0500 Subject: [PATCH 129/304] download latest api --- .github/workflows/meta.yml | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 040369870c..f046e8ad52 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -50,11 +50,11 @@ jobs: # mpi: intel #- os: windows-latest # mpi: openmpi - #- os: ubuntu-latest + #- os: ubuntu-latest # mpi: openmpi - #- os: ubuntu-latest + #- os: ubuntu-latest # mpi: mpich - #- os: ubuntu-latest + #- os: ubuntu-latest # mpi: msmpi # env: @@ -78,17 +78,24 @@ jobs: curl gcc-fortran - - name: (Ubuntu) Install Intel toolchain + - name: (Ubuntu) Retrieve Intel toolchain if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') - uses: awvwgk/setup-fortran@v1 - with: - compiler: intel-classic - version: 2021.1.1 + timeout-minutes: 1 + run: | + wget https://apt.repos.intel.com/intel-gpg-keys/GPG-PUB-KEY-INTEL-SW-PRODUCTS-2023.PUB + sudo apt-key add GPG-PUB-KEY-INTEL-SW-PRODUCTS-2023.PUB + rm GPG-PUB-KEY-INTEL-SW-PRODUCTS-2023.PUB + echo "deb https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list + sudo apt-get update + + - name: (Ubuntu) Install Intel oneAPI + if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') + timeout-minutes: 5 + run: sudo apt-get install intel-oneapi-compiler-fortran intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic intel-oneapi-mpi intel-oneapi-mpi-devel intel-oneapi-mkl ninja-build - name: (Ubuntu) Setup Intel oneAPI environment if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') run: | - sudo apt-get install intel-oneapi-mpi-2021.1.1 intel-oneapi-mpi-2021.1.1 source /opt/intel/oneapi/setvars.sh printenv >> $GITHUB_ENV @@ -233,6 +240,6 @@ jobs: run: | echo "using compiler $FPM_FC " ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" - env: + env: FPM_FC : ${{ env.FC }} From ec2d800fab426cd1049c1c21b6503f48f1e7c0f2 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 08:35:37 -0500 Subject: [PATCH 130/304] ifort: export FPM compiler flags --- .github/workflows/meta.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index f046e8ad52..c2839d0c03 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -98,6 +98,9 @@ jobs: run: | source /opt/intel/oneapi/setvars.sh printenv >> $GITHUB_ENV + echo "FPM_FC=ifort" >> $GITHUB_ENV + echo "FPM_CC=icc" >> $GITHUB_ENV + echo "FPM_CXX=icpc" >> $GITHUB_ENV - name: (Windows) Put MSYS2_MinGW64 on PATH if: contains(matrix.os,'windows') From 83bb67bc742412bc7f42e1c765a57c3277b1d284 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 08:57:19 -0500 Subject: [PATCH 131/304] ifort compiler fixes: test_manifest.f90 --- test/fpm_test/test_manifest.f90 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index ccb401b7c6..14f39991f7 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -1333,7 +1333,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 @@ -1352,7 +1352,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 @@ -1371,6 +1373,7 @@ subroutine test_macro_parsing_dependency(error) character(:), allocatable :: toml_file_package character(:), allocatable :: toml_file_dependency + character(:), allocatable :: pkg_ver,dep_ver integer :: unit integer(compiler_enum) :: id @@ -1407,8 +1410,11 @@ 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() + + macrosPackage = get_macros(id, package%preprocess(1)%macros, pkg_ver) + macrosDependency = get_macros(id, dependency%preprocess(1)%macros, dep_ver) if (macrosPackage == macrosDependency) then call test_failed(error, "Macros of package and dependency should not be equal") From f7ee4fa90f28ee14a1951ade0980d6a025e03426 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 09:07:18 -0500 Subject: [PATCH 132/304] do not bootstrap FPM with Ifort --- .github/workflows/meta.yml | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index c2839d0c03..aa3aa6474a 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -98,9 +98,6 @@ jobs: run: | source /opt/intel/oneapi/setvars.sh printenv >> $GITHUB_ENV - echo "FPM_FC=ifort" >> $GITHUB_ENV - echo "FPM_CC=icc" >> $GITHUB_ENV - echo "FPM_CXX=icpc" >> $GITHUB_ENV - name: (Windows) Put MSYS2_MinGW64 on PATH if: contains(matrix.os,'windows') @@ -176,7 +173,7 @@ jobs: ${{ env.BOOTSTRAP }} run -- --version ${{ env.BOOTSTRAP }} run -- --help - - name: Test Fortran fpm (bootstrap) + - name: Test Fortran fpm (bootstrap) shell: bash run: | ${{ env.BOOTSTRAP }} test @@ -238,10 +235,17 @@ jobs: env: EXE: fpm-${{ env.VERSION }}-${{ matrix.os-arch }}${{ matrix.exe }} + - name: (Ubuntu) Use Intel compiler for the metapackage tests + if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') + shell: bash + run: | + echo "FPM_FC=ifort" >> $GITHUB_ENV + echo "FPM_CC=icc" >> $GITHUB_ENV + echo "FPM_CXX=icpc" >> $GITHUB_ENV + - name: Run metapackage tests using the release version shell: bash run: | - echo "using compiler $FPM_FC " ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" env: FPM_FC : ${{ env.FC }} From 0ce5e0833fe8c9576c087dd6a0ecc7ddb6e1e49f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 09:13:14 -0500 Subject: [PATCH 133/304] do not override $FPM_FC --- .github/workflows/meta.yml | 2 -- src/fpm_meta.f90 | 10 +--------- 2 files changed, 1 insertion(+), 11 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index aa3aa6474a..688940c7e8 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -247,6 +247,4 @@ jobs: shell: bash run: | ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" - env: - FPM_FC : ${{ env.FC }} diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index e4807aeaed..f5e69f3ff0 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1136,19 +1136,12 @@ subroutine mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) cpp_wrappers = [string_t(get_env('I_MPI_CXX','mpiicpc'))] fort_wrappers = [string_t(get_env('I_MPI_F90','mpiifort'))] - ! temporary - deallocate(c_wrappers,cpp_wrappers,fort_wrappers) - allocate(c_wrappers(0),cpp_wrappers(0),fort_wrappers(0)) - - ! It is possible that + ! Also search MPI wrappers via the base MPI folder mpi_root = get_env('I_MPI_ROOT') - if (mpi_root/="") then mpi_root = join_path(mpi_root,'bin') - print *, 'mpi_root',mpi_root - intel_wrap = join_path(mpi_root,'mpiifort') if (get_os_type()==OS_WINDOWS) intel_wrap = get_dos_path(intel_wrap,error) if (intel_wrap/="") fort_wrappers = [fort_wrappers,string_t(intel_wrap)] @@ -1163,7 +1156,6 @@ subroutine mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) end if - case (id_pgi,id_nvhpc) c_wrappers = [c_wrappers,string_t('mpipgicc'),string_t('mpgcc')] From 0c584cb99e1b3ed0ce275bdbe8fa039a184f53ee Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 09:28:10 -0500 Subject: [PATCH 134/304] test ubuntu+openmpi --- .github/workflows/meta.yml | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 688940c7e8..840f0a2b76 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -19,6 +19,7 @@ env: HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: "ON" HOMEBREW_NO_GITHUB_API: "ON" HOMEBREW_NO_INSTALL_CLEANUP: "ON" + GCC_V: "10" jobs: @@ -28,8 +29,10 @@ jobs: fail-fast: false matrix: include: + # - os: ubuntu-latest + #mpi: intel - os: ubuntu-latest - mpi: intel + mpi: openmpi # os: [macos-11,windows-latest,ubuntu-latest] #mpi: [mpich,openmpi,msmpi,intel] #gcc_v: [10] # Version of GFortran we want to use @@ -78,6 +81,19 @@ jobs: curl gcc-fortran + - name: (Ubuntu) Install gfortran + if: contains(matrix.os,'ubuntu') && (!contains(matrix.mpi,'intel')) + run: | + sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-${GCC_V} 100 \ + --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${GCC_V} \ + --slave /usr/bin/gcov gcov /usr/bin/gcov-${GCC_V} + sudo apt-get update + + - name: (Ubuntu) Install OpenMPI + if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'openmpi') + run: | + sudo apt install -y -q openmpi-bin libopenmpi-dev + - name: (Ubuntu) Retrieve Intel toolchain if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') timeout-minutes: 1 From c7e5a51cc031a1cb3abefd4752b92626ff779797 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 09:41:11 -0500 Subject: [PATCH 135/304] add verbosity --- ci/meta_tests.sh | 17 +++++++++++------ src/fpm_meta.f90 | 2 -- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/ci/meta_tests.sh b/ci/meta_tests.sh index 16d333b530..54c70ce381 100755 --- a/ci/meta_tests.sh +++ b/ci/meta_tests.sh @@ -18,18 +18,23 @@ pushd example_packages/ rm -rf ./*/build pushd metapackage_openmp -"$fpm" build -"$fpm" run +"$fpm" build --verbose +"$fpm" run --verbose popd pushd metapackage_stdlib -"$fpm" build -"$fpm" run +"$fpm" build --verbose +"$fpm" run --verbose popd pushd metapackage_mpi -"$fpm" build -"$fpm" run +"$fpm" build --verbose +"$fpm" run --verbose +popd + +pushd metapackage_mpi_c +"$fpm" build --verbose +"$fpm" run --verbose popd # Cleanup diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index f5e69f3ff0..1c21610a45 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -796,8 +796,6 @@ subroutine get_mpi_runner(command,verbose,error) cycle end if - print *, 'command = ',command%s - ! Success! success = len_trim(command%s)>0 if (success) then From f739665f27674234167976760ccfaba0dc11777f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 09:49:44 -0500 Subject: [PATCH 136/304] request implicit typing --- src/fpm_meta.f90 | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 1c21610a45..86d1c13d3a 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -481,6 +481,13 @@ subroutine init_mpi(this,compiler,error) call init_mpi_from_wrappers(this,compiler,mpilib(LANG_FORTRAN),fwrap,cwrap,cxxwrap,error) if (allocated(error)) return + !> Request Fortran implicit typing + if (mpilib(LANG_FORTRAN)/=MPI_TYPE_INTEL) then + allocate(this%fortran) + this%fortran%implicit_typing = .true. + this%fortran%implicit_external = .true. + endif + end if 1 format('MPI wrappers found: fortran=',i0,' c=',i0,' c++=',i0) @@ -649,7 +656,7 @@ logical function msmpi_init(this,compiler,error) result(found) end if use_prebuilt - !> Request no Fortran implicit typing + !> Request Fortran implicit typing allocate(this%fortran) this%fortran%implicit_typing = .true. this%fortran%implicit_external = .true. From 9c2bc681cf1853b2aaa01ece813deae4a6c30ed2 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 09:57:29 -0500 Subject: [PATCH 137/304] Update meta.yml --- .github/workflows/meta.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 840f0a2b76..b9f6083d75 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -87,7 +87,6 @@ jobs: sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-${GCC_V} 100 \ --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${GCC_V} \ --slave /usr/bin/gcov gcov /usr/bin/gcov-${GCC_V} - sudo apt-get update - name: (Ubuntu) Install OpenMPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'openmpi') From c39ef5a991993e9f131e397ec202590ba76143fa Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 10:07:25 -0500 Subject: [PATCH 138/304] add feature flags to the linker --- src/fpm_targets.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index d04b5859b5..5a01d34eb5 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -305,7 +305,8 @@ 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)) + sources(i)%exe_name//xsuffix), & + features = model%packages(j)%features) ! If the main program is on a C/C++ source, the Intel Fortran compiler requires option @@ -839,8 +840,9 @@ subroutine resolve_target_linking(targets, model) ! If the main program is a C/C++ one, Intel compilers require additional ! linking flag -nofor-main to avoid a "duplicate main" error, see ! https://stackoverflow.com/questions/36221612/p3dfft-compilation-ifort-compiler-error-multiple-definiton-of-main - if (model%compiler%is_intel() .and. target%target_type==FPM_TARGET_EXECUTABLE) then + if (target%target_type==FPM_TARGET_EXECUTABLE) then print *, 'target compile flags ',target%compile_flags + print *, 'target fortran features ',get_feature_flags(model%compiler, target%features) end if !> Get macros as flags. From a85c3bdb00d75f15837509e8dad61d6001aa50d1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 10:11:14 -0500 Subject: [PATCH 139/304] Revert "add feature flags to the linker" This reverts commit c39ef5a991993e9f131e397ec202590ba76143fa. --- src/fpm_targets.f90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 5a01d34eb5..d04b5859b5 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -305,8 +305,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), & - features = model%packages(j)%features) + sources(i)%exe_name//xsuffix)) ! If the main program is on a C/C++ source, the Intel Fortran compiler requires option @@ -840,9 +839,8 @@ subroutine resolve_target_linking(targets, model) ! If the main program is a C/C++ one, Intel compilers require additional ! linking flag -nofor-main to avoid a "duplicate main" error, see ! https://stackoverflow.com/questions/36221612/p3dfft-compilation-ifort-compiler-error-multiple-definiton-of-main - if (target%target_type==FPM_TARGET_EXECUTABLE) then + if (model%compiler%is_intel() .and. target%target_type==FPM_TARGET_EXECUTABLE) then print *, 'target compile flags ',target%compile_flags - print *, 'target fortran features ',get_feature_flags(model%compiler, target%features) end if !> Get macros as flags. From 8efb37554d8e9856e758f01504f9f9850e9f7eda Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 10:12:18 -0500 Subject: [PATCH 140/304] restore mac builds --- .github/workflows/meta.yml | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index b9f6083d75..9b69069ecc 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -29,10 +29,16 @@ jobs: fail-fast: false matrix: include: - # - os: ubuntu-latest - #mpi: intel - - os: ubuntu-latest - mpi: openmpi + - os: ubuntu-latest + mpi: intel + - os: macos-11 + mpi: openmpi + - os: macos-11 + mpi: mpich + #- os: windows-latest # temporary + # mpi: msmpi + # - os: ubuntu-latest DOES NOT WORK + #mpi: openmpi # os: [macos-11,windows-latest,ubuntu-latest] #mpi: [mpich,openmpi,msmpi,intel] #gcc_v: [10] # Version of GFortran we want to use @@ -41,12 +47,6 @@ jobs: # mpi: intel #- os: macos-11 # mpi: msmpi - #- os: macos-11 # temporary - # mpi: openmpi - #- os: macos-11 # temporary - # mpi: mpich - #- os: windows-latest # temporary - # mpi: msmpi #- os: windows-latest # mpi: mpich #- os: windows-latest From 82b992b8bfba8520a6545a25d54ee98e9fdf6db9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 12:54:00 -0500 Subject: [PATCH 141/304] GCC: do not care about linker order --- src/fpm_meta.f90 | 103 ++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 94 insertions(+), 9 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 86d1c13d3a..cc7b6da9e4 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -970,12 +970,30 @@ subroutine init_mpi_from_wrappers(this,compiler,mpilib,fort_wrapper,c_wrapper,cx ! Get linking flags if (mpilib/=MPI_TYPE_INTEL) then this%link_flags = mpi_wrapper_query(mpilib,fort_wrapper,'link',verbose,error) + + ! We fix OpenMPI's Fortran wrapper bug (https://github.com/open-mpi/ompi/issues/11636) + !call fix_openmpi_link_flags(this%link_flags,compiler,mpilib,fort_wrapper,c_wrapper,cxx_wrapper,error) + if (allocated(error)) return this%has_link_flags = len_trim(this%link_flags)>0 endif ! Add heading space - if (this%has_link_flags) this%link_flags = string_t(' '//this%link_flags%s) + if (this%has_link_flags) then + this%link_flags = string_t(' -Wl,--start-group '//this%link_flags%s) + +! ! If +! if (compiler%) then +! ! +! +! -Wl,--start-group +! +! +! end if + + + end if + ! Add language-specific flags call set_language_flags(mpilib,fort_wrapper,this%has_fortran_flags,this%fflags,verbose,error) @@ -1026,6 +1044,73 @@ end subroutine set_language_flags end subroutine init_mpi_from_wrappers +! Due to OpenMPI's Fortran wrapper bug (https://github.com/open-mpi/ompi/issues/11636) +! we need to check whether all library directories are real +subroutine check_openmpi_lib_dirs(link_flags,compiler,mpilib,fort_wrapper,c_wrapper,cxx_wrapper,error) + type(string_t), intent(inout) :: link_flags + type(compiler_t), intent(in) :: compiler + integer, intent(in) :: mpilib + type(string_t), intent(in) :: fort_wrapper,c_wrapper,cxx_wrapper + type(error_t), allocatable, intent(out) :: error + + character(:), allocatable :: tokens(:),dtokens(:),dir_name,cdir_name + type(string_t), allocatable :: include_dirs(:),dir_tokens(:) + type(string_t) :: new_dirs + integer :: i, j, k + integer, allocatable :: invalid_dirs(:) + + if (mpilib/=MPI_TYPE_OPENMPI .or. .not.os_is_unix()) return + if (len_trim(link_flags)<=0) return + + ! Extract library directory (-L/path/to/dir) from the linker flags + call split(link_flags%s,tokens,' ') + + allocate(invalid_dirs(0),include_dirs(0)) + check_lib_directories: do i=1,size(tokens) + if (str_begins_with_str(tokens(i),'-L')) then + dir_name = trim(tokens(i)(3:)) + if (.not.exists(join_path(dir_name,'.'))) then + invalid_dirs = [invalid_dirs,i] + print *, 'invalid directory: ',dir_name + endif + endif + end do check_lib_directories + + ! No invalid directories found + if (size(invalid_dirs)<=0) return + + ! The only viable strategy is to replace all invalid directory with all include directories. + ! Because include directories have Fortran .mod files and mpif.h, we hope the library files are there too. + ! Include directories need to be retrieved + if (size(invalid_dirs)>0 ) then + + ! Query include libraries for Fortran + new_dirs = mpi_wrapper_query(mpilib,fort_wrapper,'incl_dirs',verbose,error) + if (allocated(error) .or. len_trim(new_dirs)<=0) return + + ! Split into strings + call split(new_dirs%s,dtokens,' ') + allocate(dir_tokens(size(dtokens))) + do i=1,size(dtokens) + dir_tokens(i) = string_t('-L'//trim(adjustl(dtokens(i)))) + end do + new_dirs%s = string_cat(dir_tokens,' ') + + ! Assemble a unique token with the new library dirs + link_flags = string_t("") + do i=1,size(tokens) + if (i==invalid_dirs(1)) then + ! Replace invalid directory with the new library dirs + link_flags%s = link_flags%s//' '//trim(new_dirs%s) + else + link_flags%s = link_flags%s//' '//trim(tokens(i)) + end if + end do + + endif + +end subroutine check_openmpi_lib_dirs + !> Match one of the available compiler wrappers with the current compiler subroutine mpi_compiler_match(language,wrappers,compiler,which_one,mpilib,error) integer, intent(in) :: language @@ -1384,10 +1469,6 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) return end if - ! Take out the first command from the whole line - call split(screen%s,tokens,delimiters=' ') - screen%s = trim(tokens(1)) - case (MPI_TYPE_INTEL) ! -show returns the build command of this wrapper @@ -1399,10 +1480,6 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) return end if - ! Take out the first command from the whole line - call split(screen%s,tokens,delimiters=' ') - screen%s = trim(tokens(1)) - print *, 'INTEL MPI compiler: ',screen%s case default @@ -1412,6 +1489,9 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) end select + ! Take out the first command from the whole line + call split(screen%s,tokens,delimiters=' ') + screen%s = trim(adjustl(tokens(1))) ! Get a list of additional compiler flags case ('flags') @@ -1486,6 +1566,9 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) call remove_new_lines(screen) + !> Address OpenMPI wrapper bug + + case (MPI_TYPE_MPICH) call run_mpi_wrapper(wrapper,[string_t('-link-info')],verbose=verbose, & @@ -1553,6 +1636,8 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) end select + call remove_new_lines(screen) + ! Retrieve library version case ('version') From 8b992dc289b09e0d236668dbefc87e8abcf7bc68 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 12:57:47 -0500 Subject: [PATCH 142/304] intel crash fix --- src/fpm_targets.f90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index d04b5859b5..6feb1ef48a 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -308,25 +308,29 @@ subroutine build_target_list(targets,model) sources(i)%exe_name//xsuffix)) + associate(target=>targets(size(targets))%ptr) + ! If the main program is on a C/C++ source, the Intel Fortran compiler requires option ! -nofor-main to avoid "duplicate main" errors. ! https://stackoverflow.com/questions/36221612/p3dfft-compilation-ifort-compiler-error-multiple-definiton-of-main if (model%compiler%is_intel() .and. any(exe_type==[FPM_TARGET_C_OBJECT,FPM_TARGET_CPP_OBJECT])) then if (get_os_type()==OS_WINDOWS) then - targets(size(targets))%ptr%compile_flags = '/nofor-main' + target%compile_flags = '/nofor-main' else - targets(size(targets))%ptr%compile_flags = '-nofor-main' + target%compile_flags = '-nofor-main' end if end if ! Executable depends on object - call add_dependency(targets(size(targets))%ptr, targets(size(targets)-1)%ptr) + call add_dependency(target, targets(size(targets)-1)%ptr) if (with_lib) then ! Executable depends on library - call add_dependency(targets(size(targets))%ptr, targets(1)%ptr) + call add_dependency(target, targets(1)%ptr) end if + endassociate + end select end do From ee3fb61a1c1c3bfce9cd2eb97ab9c044c3c23d8a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 13:00:25 -0500 Subject: [PATCH 143/304] restore ubuntu openmpi --- .github/workflows/meta.yml | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 9b69069ecc..f5c262196b 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -31,9 +31,11 @@ jobs: include: - os: ubuntu-latest mpi: intel - - os: macos-11 + - os: ubuntu-latest + mpi: openmpi + - os: macos-11 mpi: openmpi - - os: macos-11 + - os: macos-11 mpi: mpich #- os: windows-latest # temporary # mpi: msmpi @@ -81,12 +83,12 @@ jobs: curl gcc-fortran - - name: (Ubuntu) Install gfortran + - name: (Ubuntu) Install gfortran if: contains(matrix.os,'ubuntu') && (!contains(matrix.mpi,'intel')) run: | sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-${GCC_V} 100 \ --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${GCC_V} \ - --slave /usr/bin/gcov gcov /usr/bin/gcov-${GCC_V} + --slave /usr/bin/gcov gcov /usr/bin/gcov-${GCC_V} - name: (Ubuntu) Install OpenMPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'openmpi') @@ -188,7 +190,7 @@ jobs: ${{ env.BOOTSTRAP }} run -- --version ${{ env.BOOTSTRAP }} run -- --help - - name: Test Fortran fpm (bootstrap) + - name: Test Fortran fpm (bootstrap) shell: bash run: | ${{ env.BOOTSTRAP }} test From 83f6a793b6c4f0b4bcf403e21967ba97e0306c23 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 13:03:28 -0500 Subject: [PATCH 144/304] C, C++ examples: add implicit features --- example_packages/metapackage_mpi_c/fpm.toml | 4 ++++ example_packages/metapackage_mpi_cpp/fpm.toml | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/example_packages/metapackage_mpi_c/fpm.toml b/example_packages/metapackage_mpi_c/fpm.toml index 8fff9db364..ffbb88a139 100644 --- a/example_packages/metapackage_mpi_c/fpm.toml +++ b/example_packages/metapackage_mpi_c/fpm.toml @@ -9,6 +9,10 @@ copyright = "Copyright 2023, Federico Perini and the fpm maintainers" name = "test-mpi-c-main" main = "main.c" +[fortran] +implicit-typing=true +implicit-external=true + [dependencies] mpi = true diff --git a/example_packages/metapackage_mpi_cpp/fpm.toml b/example_packages/metapackage_mpi_cpp/fpm.toml index 7b2c39d386..5d236bcc89 100644 --- a/example_packages/metapackage_mpi_cpp/fpm.toml +++ b/example_packages/metapackage_mpi_cpp/fpm.toml @@ -9,6 +9,10 @@ copyright = "Copyright 2023, Federico Perini and the fpm maintainers" name = "test-mpi-cpp" main = "main.cpp" +[fortran] +implicit-typing=true +implicit-external=true + [dependencies] mpi = true From 812edce1c9a52852bb2d2ecc981cde24a6a222cf Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 20:35:56 +0200 Subject: [PATCH 145/304] ubuntu MPICH --- .github/workflows/meta.yml | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index f5c262196b..5f55af21a7 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -33,9 +33,7 @@ jobs: mpi: intel - os: ubuntu-latest mpi: openmpi - - os: macos-11 - mpi: openmpi - - os: macos-11 + - os: ubuntu-latest mpi: mpich #- os: windows-latest # temporary # mpi: msmpi @@ -95,6 +93,11 @@ jobs: run: | sudo apt install -y -q openmpi-bin libopenmpi-dev + - name: (Ubuntu) Install MPICH + if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'mpich') + run: | + sudo apt install -y -q mpich + - name: (Ubuntu) Retrieve Intel toolchain if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') timeout-minutes: 1 From cf986e39eedf4e0a38b5f68896e2b2bc4c5fae2d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 21:03:41 +0200 Subject: [PATCH 146/304] print version line --- src/fpm_meta.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index cc7b6da9e4..8252964c47 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1184,6 +1184,8 @@ type(version_t) function mpi_version_get(mpilib,wrapper,error) version_line = mpi_wrapper_query(mpilib,wrapper,'version',error=error) if (allocated(error)) return + print *, 'version line = ',version_line%s + ! Wrap to object call new_version(mpi_version_get,version_line%s,error) @@ -1696,6 +1698,8 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) return else + print *, 'version line=',screen%s + ! Extract version ire = regex(screen%s,'\d+.\d+.\d+',length=length) if (ire>0 .and. length>0) then From caf0dc16d9da7a3009e37738592e72269c4767d1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 21:24:27 +0200 Subject: [PATCH 147/304] wrap version string extractor --- src/fpm_meta.f90 | 93 ++++++++++++++++++++++-------------------------- 1 file changed, 43 insertions(+), 50 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 8252964c47..c3563e974f 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -836,6 +836,7 @@ subroutine compiler_get_version(self,version,is_msys2,error) type(error_t), allocatable, intent(out) :: error character(:), allocatable :: tmp_file,screen_output,line + type(string_t) :: ver integer :: stat,iunit,ire,length is_msys2 = .false. @@ -869,19 +870,11 @@ subroutine compiler_get_version(self,version,is_msys2,error) ! Check if this gcc is from the MSYS2 project is_msys2 = index(screen_output,'MSYS2')>0 - ! Extract version - ire = regex(screen_output,'\d+.\d+.\d+',length=length) - - if (ire>0 .and. length>0) then - ! Parse version into the object (this should always work) - screen_output = screen_output(ire:ire+length-1) - else - call syntax_error(error,'cannot retrieve '//self%fc//' compiler version.') - return - end if + ver = extract_version_text(screen_output,self%fc//' compiler',error) + if (allocated(error)) return - ! Wrap to object - call new_version(version,screen_output,error) + ! Extract version + call new_version(version,ver%s,error) case default @@ -1658,18 +1651,8 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) end if ! Extract version - ire = regex(screen%s,'\d+.\d+.\d+',length=length) - - if (ire>0 .and. length>0) then - - ! Parse version into the object (this should always work) - screen%s = screen%s(ire:ire+length-1) - - else - - call syntax_error(error,'cannot retrieve OpenMPI library version.') - - end if + screen = extract_version_text(screen%s,'OpenMPI library',error) + if (allocated(error)) return case (MPI_TYPE_MPICH) @@ -1698,16 +1681,8 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) return else - print *, 'version line=',screen%s - - ! Extract version - ire = regex(screen%s,'\d+.\d+.\d+',length=length) - if (ire>0 .and. length>0) then - ! Parse version into the object (this should always work) - screen%s = screen%s(ire:ire+length-1) - else - call syntax_error(error,'cannot retrieve MPICH library version.') - end if + screen = extract_version_text(screen%s,'MPICH library',error) + if (allocated(error)) return end if @@ -1724,23 +1699,9 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) call remove_new_lines(screen) end if - print *, 'version screen = ',screen%s - ! Extract version - ire = regex(screen%s,'\d+\.\d+\.\d+',length=length) - - print *, 'ire = ',ire,' length=',length - - if (ire>0 .and. length>0) then - - ! Parse version into the object (this should always work) - screen%s = screen%s(ire:ire+length-1) - - else - - call syntax_error(error,'cannot retrieve INTEL MPI library version.') - - end if + screen = extract_version_text(screen%s,'INTEL MPI library',error) + if (allocated(error)) return case default @@ -1800,4 +1761,36 @@ subroutine remove_new_lines(string) end subroutine remove_new_lines +type(string_t) function extract_version_text(text,what,error) result(ver) + character(*), intent(in) :: text + character(*), intent(in) :: what + type(error_t), allocatable, intent(out) :: error + + integer :: ire, length + + if (len_trim(text)<=0) then + call syntax_error(error,'cannot retrieve '//what//' version: empty input string') + return + end if + + ! Extract 3-sized version "1.0.4" + ire = regex(text,'\d+\.\d+\.\d+',length=length) + if (ire>0 .and. length>0) then + ! Parse version into the object (this should always work) + ver = string_t(text(ire:ire+length-1)) + else + + ! Try 2-sized version "1.0" + ire = regex(text,'\d+\.\d+',length=length) + + if (ire>0 .and. length>0) then + ver = string_t(text(ire:ire+length-1)) + else + call syntax_error(error,'cannot retrieve '//what//' version.') + end if + + end if + +end function extract_version_text + end module fpm_meta From 25ac71f30a5fab9ef42b5916902c2e7268ff07fb Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 21:31:46 +0200 Subject: [PATCH 148/304] fix linker library order for mac --- src/fpm_compiler.F90 | 7 +++++++ src/fpm_meta.f90 | 17 +++-------------- 2 files changed, 10 insertions(+), 14 deletions(-) diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index 54b146a4ef..cc3e7d0f19 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -107,6 +107,8 @@ module fpm_compiler procedure :: is_unknown !> Check whether this is an Intel compiler procedure :: is_intel + !> Check whether this is a GNU compiler + procedure :: is_gnu !> Enumerate libraries, based on compiler and platform procedure :: enumerate_libraries !> Return compiler name @@ -899,6 +901,11 @@ pure logical function is_intel(self) id_intel_llvm_nix,id_intel_llvm_windows,id_intel_llvm_unknown]) end function is_intel +pure logical function is_gnu(self) + class(compiler_t), intent(in) :: self + is_gnu = any(self%id == [id_f95,id_gcc,id_caf]) +end function is_gnu + !> !> Enumerate libraries, based on compiler and platform !> diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index c3563e974f..97bbb5c84a 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -971,20 +971,9 @@ subroutine init_mpi_from_wrappers(this,compiler,mpilib,fort_wrapper,c_wrapper,cx this%has_link_flags = len_trim(this%link_flags)>0 endif - ! Add heading space - if (this%has_link_flags) then - this%link_flags = string_t(' -Wl,--start-group '//this%link_flags%s) - -! ! If -! if (compiler%) then -! ! -! -! -Wl,--start-group -! -! -! end if - - + ! Request to use libs in arbitrary order + if (this%has_link_flags .and. compiler%is_gnu() .and. os_is_unix() .and. get_os_type()/=OS_MACOS) then + this%link_flags = string_t(' -Wl,--as-needed '//this%link_flags%s) end if From 59c5dbde7d3d1b56eb449400db0b7c7704ecf9c8 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 21:38:46 +0200 Subject: [PATCH 149/304] start-group --- src/fpm_meta.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 97bbb5c84a..07a6c63e3d 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -973,7 +973,7 @@ subroutine init_mpi_from_wrappers(this,compiler,mpilib,fort_wrapper,c_wrapper,cx ! Request to use libs in arbitrary order if (this%has_link_flags .and. compiler%is_gnu() .and. os_is_unix() .and. get_os_type()/=OS_MACOS) then - this%link_flags = string_t(' -Wl,--as-needed '//this%link_flags%s) + this%link_flags = string_t(' -Wl,--start-group '//this%link_flags%s) end if From 04a702482bc20f31d5525e81d406b5fad263e05b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 21:50:57 +0200 Subject: [PATCH 150/304] activate windows + msmpi --- .github/workflows/meta.yml | 27 ++------------------------- 1 file changed, 2 insertions(+), 25 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 5f55af21a7..d88ffc2501 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -35,31 +35,8 @@ jobs: mpi: openmpi - os: ubuntu-latest mpi: mpich - #- os: windows-latest # temporary - # mpi: msmpi - # - os: ubuntu-latest DOES NOT WORK - #mpi: openmpi - # os: [macos-11,windows-latest,ubuntu-latest] - #mpi: [mpich,openmpi,msmpi,intel] - #gcc_v: [10] # Version of GFortran we want to use - #exclude: - #- os: macos-11 - # mpi: intel - #- os: macos-11 - # mpi: msmpi - #- os: windows-latest - # mpi: mpich - #- os: windows-latest - # mpi: intel - #- os: windows-latest - # mpi: openmpi - #- os: ubuntu-latest - # mpi: openmpi - #- os: ubuntu-latest - # mpi: mpich - #- os: ubuntu-latest - # mpi: msmpi - + - os: windows-latest + mpi: msmpi # env: # FC: gfortran # GCC_V: ${{ matrix.gcc_v }} From c958e37e22094fb94f732293d02b9d59d23a9897 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 22:11:30 +0200 Subject: [PATCH 151/304] cleanup debugging messages --- src/fpm_meta.f90 | 89 +++--------------------------------------------- 1 file changed, 5 insertions(+), 84 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 07a6c63e3d..84378a42d3 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -469,13 +469,14 @@ subroutine init_mpi(this,compiler,error) !> fortran compiler suite, we still want to enable C language flags as that is most likely being !> ABI-compatible anyways. However, issues may arise. !> see e.g. Homebrew with clabng C/C++ and GNU fortran at https://gitlab.kitware.com/cmake/cmake/-/issues/18139 - if (wcfit(LANG_FORTRAN)>0 .and. wcfit(LANG_C)==0 .and. wcfit(LANG_CXX)==0) then + if (wcfit(LANG_FORTRAN)>0 .and. all(wcfit([LANG_C,LANG_CXX])==0)) then cwrap = fort_wrappers(wcfit(LANG_FORTRAN)) cxxwrap = fort_wrappers(wcfit(LANG_FORTRAN)) end if - print *, 'wcfit = ',wcfit - print *, 'mpilib = ',mpilib + if (verbose) print *, '+ fortran MPI wrapper: ',fwrap%s + if (verbose) print *, '+ c MPI wrapper: ',cwrap%s + if (verbose) print *, '+ c++ MPI wrapper: ',cxxwrap%s !> Initialize MPI package from wrapper command call init_mpi_from_wrappers(this,compiler,mpilib(LANG_FORTRAN),fwrap,cwrap,cxxwrap,error) @@ -1018,7 +1019,7 @@ subroutine set_language_flags(mpilib,wrapper,has_flags,flags,verbose,error) ! Add heading space flags = string_t(' '//flags%s) - if (verbose) print *, 'MPI set language flags from wrapper <',wrapper%s,'>: flags=',flags%s + if (verbose) print *, '+ MPI language flags from wrapper <',wrapper%s,'>: flags=',flags%s endif @@ -1026,73 +1027,6 @@ end subroutine set_language_flags end subroutine init_mpi_from_wrappers -! Due to OpenMPI's Fortran wrapper bug (https://github.com/open-mpi/ompi/issues/11636) -! we need to check whether all library directories are real -subroutine check_openmpi_lib_dirs(link_flags,compiler,mpilib,fort_wrapper,c_wrapper,cxx_wrapper,error) - type(string_t), intent(inout) :: link_flags - type(compiler_t), intent(in) :: compiler - integer, intent(in) :: mpilib - type(string_t), intent(in) :: fort_wrapper,c_wrapper,cxx_wrapper - type(error_t), allocatable, intent(out) :: error - - character(:), allocatable :: tokens(:),dtokens(:),dir_name,cdir_name - type(string_t), allocatable :: include_dirs(:),dir_tokens(:) - type(string_t) :: new_dirs - integer :: i, j, k - integer, allocatable :: invalid_dirs(:) - - if (mpilib/=MPI_TYPE_OPENMPI .or. .not.os_is_unix()) return - if (len_trim(link_flags)<=0) return - - ! Extract library directory (-L/path/to/dir) from the linker flags - call split(link_flags%s,tokens,' ') - - allocate(invalid_dirs(0),include_dirs(0)) - check_lib_directories: do i=1,size(tokens) - if (str_begins_with_str(tokens(i),'-L')) then - dir_name = trim(tokens(i)(3:)) - if (.not.exists(join_path(dir_name,'.'))) then - invalid_dirs = [invalid_dirs,i] - print *, 'invalid directory: ',dir_name - endif - endif - end do check_lib_directories - - ! No invalid directories found - if (size(invalid_dirs)<=0) return - - ! The only viable strategy is to replace all invalid directory with all include directories. - ! Because include directories have Fortran .mod files and mpif.h, we hope the library files are there too. - ! Include directories need to be retrieved - if (size(invalid_dirs)>0 ) then - - ! Query include libraries for Fortran - new_dirs = mpi_wrapper_query(mpilib,fort_wrapper,'incl_dirs',verbose,error) - if (allocated(error) .or. len_trim(new_dirs)<=0) return - - ! Split into strings - call split(new_dirs%s,dtokens,' ') - allocate(dir_tokens(size(dtokens))) - do i=1,size(dtokens) - dir_tokens(i) = string_t('-L'//trim(adjustl(dtokens(i)))) - end do - new_dirs%s = string_cat(dir_tokens,' ') - - ! Assemble a unique token with the new library dirs - link_flags = string_t("") - do i=1,size(tokens) - if (i==invalid_dirs(1)) then - ! Replace invalid directory with the new library dirs - link_flags%s = link_flags%s//' '//trim(new_dirs%s) - else - link_flags%s = link_flags%s//' '//trim(tokens(i)) - end if - end do - - endif - -end subroutine check_openmpi_lib_dirs - !> Match one of the available compiler wrappers with the current compiler subroutine mpi_compiler_match(language,wrappers,compiler,which_one,mpilib,error) integer, intent(in) :: language @@ -1111,16 +1045,11 @@ subroutine mpi_compiler_match(language,wrappers,compiler,which_one,mpilib,error) do i=1,size(wrappers) - print *, 'TEST WRAPPER '//wrappers(i)%s - mpilib = which_mpi_library(wrappers(i),compiler,verbose=.false.) screen = mpi_wrapper_query(mpilib,wrappers(i),'compiler',verbose=.false.,error=error) if (allocated(error)) return - print *, 'screen <'//screen%s//'> compiler ',compiler%fc,' language = ',language - - select case (language) case (LANG_FORTRAN) ! Build compiler type. The ID is created based on the Fortran name @@ -1166,8 +1095,6 @@ type(version_t) function mpi_version_get(mpilib,wrapper,error) version_line = mpi_wrapper_query(mpilib,wrapper,'version',error=error) if (allocated(error)) return - print *, 'version line = ',version_line%s - ! Wrap to object call new_version(mpi_version_get,version_line%s,error) @@ -1373,15 +1300,11 @@ integer function which_mpi_library(wrapper,compiler,verbose) ! Init as currently unsupported library which_mpi_library = MPI_TYPE_NONE - print *, 'len_trim= ',len_trim(wrapper) - if (len_trim(wrapper)<=0) return ! Run mpi wrapper first call run_mpi_wrapper(wrapper,verbose=verbose,cmd_success=is_mpi_wrapper) - print *, 'is_mpi_wrapper=',is_mpi_wrapper,' wrapper = ',wrapper%s - if (is_mpi_wrapper) then if (compiler%is_intel()) then @@ -1464,8 +1387,6 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) return end if - print *, 'INTEL MPI compiler: ',screen%s - case default call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) From f724a26892ff28e480c07033563b2b535ecaca82 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 22:23:09 +0200 Subject: [PATCH 152/304] test msmpi --- src/fpm_meta.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 84378a42d3..9466dad6a8 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -573,6 +573,8 @@ logical function msmpi_init(this,compiler,error) result(found) ! Check that the runtime is installed bindir = get_env('MSMPI_BIN') + print *, 'bindir=',bindir + ! In some environments, variable %MSMPI_BIN% is missing (i.e. in GitHub Action images). ! Do a second attempt: search for mpiexec.exe if (len_trim(bindir)<=0 .or. .not.exists(bindir)) then @@ -715,6 +717,8 @@ subroutine find_command_location(command,path,echo,verbose,error) return end if + print *, 'searching '//command + tmp_file = get_temp_filename() if (get_os_type()==OS_WINDOWS) then @@ -723,7 +727,7 @@ subroutine find_command_location(command,path,echo,verbose,error) call run("which "//command, echo=echo, exitstat=stat, verbose=verbose, redirect=tmp_file) end if if (stat/=0) then - call fatal_error(error,'compiler_get_path failed for '//command) + call fatal_error(error,'find_command_location failed for '//command) return end if From c608c96e118fdcf63ce280b3e7c32267d5e8c43b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 22:37:14 +0200 Subject: [PATCH 153/304] cleanup --- src/fpm_meta.f90 | 30 +++++++++--------------------- 1 file changed, 9 insertions(+), 21 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 9466dad6a8..aee1561425 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -474,9 +474,9 @@ subroutine init_mpi(this,compiler,error) cxxwrap = fort_wrappers(wcfit(LANG_FORTRAN)) end if - if (verbose) print *, '+ fortran MPI wrapper: ',fwrap%s - if (verbose) print *, '+ c MPI wrapper: ',cwrap%s - if (verbose) print *, '+ c++ MPI wrapper: ',cxxwrap%s + if (verbose) print *, '+ MPI fortran wrapper: ',fwrap%s + if (verbose) print *, '+ MPI c wrapper: ',cwrap%s + if (verbose) print *, '+ MPI c++ wrapper: ',cxxwrap%s !> Initialize MPI package from wrapper command call init_mpi_from_wrappers(this,compiler,mpilib(LANG_FORTRAN),fwrap,cwrap,cxxwrap,error) @@ -709,7 +709,7 @@ subroutine find_command_location(command,path,echo,verbose,error) logical, optional, intent(in) :: echo,verbose type(error_t), allocatable, intent(out) :: error - character(:), allocatable :: tmp_file,screen_output,line,fullpath + character(:), allocatable :: tmp_file,screen_output,line,fullpath,search_command integer :: stat,iunit,ire,length if (len_trim(command)<=0) then @@ -717,15 +717,11 @@ subroutine find_command_location(command,path,echo,verbose,error) return end if - print *, 'searching '//command - tmp_file = get_temp_filename() - if (get_os_type()==OS_WINDOWS) then - call run("where "//command, echo=echo, exitstat=stat, verbose=verbose, redirect=tmp_file) - else - call run("which "//command, echo=echo, exitstat=stat, verbose=verbose, redirect=tmp_file) - end if + search_command = merge("where ","which ",get_os_type()==OS_WINDOWS)//command + + call run(search_command, echo=echo, exitstat=stat, verbose=verbose, redirect=tmp_file) if (stat/=0) then call fatal_error(error,'find_command_location failed for '//command) return @@ -763,11 +759,8 @@ subroutine find_command_location(command,path,echo,verbose,error) return end if - print *, 'fullpath <'//fullpath//'>, command=<'//command//'>' - ! Extract path only length = index(fullpath,command,BACK=.true.) - print *, 'length=',length if (length<=0) then call fatal_error(error,'full path to command ('//command//') does not include command name') return @@ -802,11 +795,7 @@ subroutine get_mpi_runner(command,verbose,error) ! Try several commands do itri=1,size(try) call find_command_location(trim(try(itri)),command%s,verbose=.true.,error=error) - - if (allocated(error)) then - print *, 'error returned: ',error%message - cycle - end if + if (allocated(error)) cycle ! Success! success = len_trim(command%s)>0 @@ -814,7 +803,6 @@ subroutine get_mpi_runner(command,verbose,error) command%s = join_path(command%s,trim(try(itri))) return endif - end do ! No valid command found @@ -1193,7 +1181,7 @@ subroutine assert_mpi_wrappers(wrappers,compiler,verbose) allocate(works(size(wrappers))) do i=1,size(wrappers) - print *, 'test wrapper <', wrappers(i)%s,'>' + if (verbose) print *, '+ MPI test wrapper <',wrappers(i)%s,'>' works(i) = which_mpi_library(wrappers(i),compiler,verbose) end do From 4ca8e8df679427e82c10e616337034185a9e99dd Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 22:41:50 +0200 Subject: [PATCH 154/304] try both which, where on WSL --- src/fpm_meta.f90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index aee1561425..2833bc46fe 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -710,7 +710,8 @@ subroutine find_command_location(command,path,echo,verbose,error) type(error_t), allocatable, intent(out) :: error character(:), allocatable :: tmp_file,screen_output,line,fullpath,search_command - integer :: stat,iunit,ire,length + integer :: stat,iunit,ire,length,try + character(*), parameter :: search(2) = ["where ","which "] if (len_trim(command)<=0) then call fatal_error(error,'empty command provided in find_command_location') @@ -719,9 +720,12 @@ subroutine find_command_location(command,path,echo,verbose,error) tmp_file = get_temp_filename() - search_command = merge("where ","which ",get_os_type()==OS_WINDOWS)//command - - call run(search_command, echo=echo, exitstat=stat, verbose=verbose, redirect=tmp_file) + ! On Windows, we try both commands because we may be on WSL + do try=merge(1,2,get_os_type()==OS_WINDOWS),2 + search_command = search(try)//command + call run(search_command, echo=echo, exitstat=stat, verbose=verbose, redirect=tmp_file) + if (stat==0) exit + end do if (stat/=0) then call fatal_error(error,'find_command_location failed for '//command) return From 0ff6be9e70872bf15a4f3743dc0f025429642537 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 2 May 2023 22:45:02 +0200 Subject: [PATCH 155/304] fix verbose --- src/fpm_meta.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 2833bc46fe..2c26ea6a78 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1185,7 +1185,9 @@ subroutine assert_mpi_wrappers(wrappers,compiler,verbose) allocate(works(size(wrappers))) do i=1,size(wrappers) - if (verbose) print *, '+ MPI test wrapper <',wrappers(i)%s,'>' + if (present(verbose)) then + if (verbose) print *, '+ MPI test wrapper <',wrappers(i)%s,'>' + endif works(i) = which_mpi_library(wrappers(i),compiler,verbose) end do From 3feaae3d2f6b4790c57362068bcc93518dbe1d41 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 08:27:55 +0200 Subject: [PATCH 156/304] cleanup MPI wrapper function --- src/fpm_meta.f90 | 186 ++++++++++++++++------------------------------- 1 file changed, 61 insertions(+), 125 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 2c26ea6a78..bf3efcf54f 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1248,7 +1248,6 @@ subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_outp endif add_arguments if (echo_local) print *, '+ ', command - print *, '+ ', command ! Test command call execute_command_line(command//redirect_str,exitstat=stat,cmdstat=cmdstat) @@ -1341,57 +1340,36 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) type(error_t), allocatable, intent(out) :: error logical :: success - character(:), allocatable :: redirect_str,tokens(:) + character(:), allocatable :: redirect_str,tokens(:),unsupported_msg type(string_t) :: cmdstr type(compiler_t) :: mpi_compiler integer :: stat,cmdstat,ire,length + unsupported_msg = 'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command) + select case (command) ! Get MPI compiler name case ('compiler') select case (mpilib) - case (MPI_TYPE_OPENMPI) - - ! --showme:command returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('--showme:command')],verbose=verbose, & - exitcode=stat,cmd_success=success,screen_output=screen) - - if (stat/=0 .or. .not.success) then - call syntax_error(error,'local OpenMPI library does not support --showme:command') - return - end if - - case (MPI_TYPE_MPICH) - - ! -compile_info returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('-compile-info')],verbose=verbose, & - exitcode=stat,cmd_success=success,screen_output=screen) - - if (stat/=0 .or. .not.success) then - call syntax_error(error,'local MPICH library does not support -compile-info') - return - end if - - case (MPI_TYPE_INTEL) - - ! -show returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('-show')],verbose=verbose, & - exitcode=stat,cmd_success=success,screen_output=screen) - - if (stat/=0 .or. .not.success) then - call syntax_error(error,'local INTEL MPI library does not support -show') - return - end if - + case (MPI_TYPE_OPENMPI); cmdstr = string_t('--showme:command') + case (MPI_TYPE_MPICH); cmdstr = string_t('-compile-info') + case (MPI_TYPE_INTEL); cmdstr = string_t('-show') case default - - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) + call fatal_error(error,unsupported_msg) return - end select + call run_mpi_wrapper(wrapper,[cmdstr],verbose=verbose, & + exitcode=stat,cmd_success=success,screen_output=screen) + + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local '//MPI_TYPE_NAME(mpilib)//& + ' library wrapper does not support flag '//cmdstr%s) + return + end if + ! Take out the first command from the whole line call split(screen%s,tokens,delimiters=' ') screen%s = trim(adjustl(tokens(1))) @@ -1400,99 +1378,71 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) case ('flags') select case (mpilib) - case (MPI_TYPE_OPENMPI) - - ! --showme:command returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('--showme:compile')],verbose=verbose, & - exitcode=stat,cmd_success=success,screen_output=screen) - - if (stat/=0 .or. .not.success) then - call syntax_error(error,'local OpenMPI library does not support --showme:compile') - return - end if - - call remove_new_lines(screen) - - case (MPI_TYPE_MPICH) + case (MPI_TYPE_OPENMPI); cmdstr = string_t('--showme:compile') + case (MPI_TYPE_MPICH); cmdstr = string_t('-compile-info') + case (MPI_TYPE_INTEL); cmdstr = string_t('-show') + case default + call fatal_error(error,unsupported_msg) + return + end select - call run_mpi_wrapper(wrapper,[string_t('-compile-info')],verbose=verbose, & - exitcode=stat,cmd_success=success,screen_output=screen) + call run_mpi_wrapper(wrapper,[cmdstr],verbose=verbose, & + exitcode=stat,cmd_success=success,screen_output=screen) - if (stat/=0 .or. .not.success) then - call syntax_error(error,'local MPICH library does not support -compile-info') - return - end if + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local '//MPI_TYPE_NAME(mpilib)//& + ' library wrapper does not support flag '//cmdstr%s) + return + end if - ! MPICH reports the full command including the compiler name. Remove it if so + ! Post-process output + select case (mpilib) + case (MPI_TYPE_OPENMPI) + ! This library reports the compiler name only call remove_new_lines(screen) - call split(screen%s,tokens) - ! Remove trailing compiler name - screen%s = screen%s(len_trim(tokens(1))+1:) - - case (MPI_TYPE_INTEL) - - call run_mpi_wrapper(wrapper,[string_t('-show')],verbose=verbose, & - exitcode=stat,cmd_success=success,screen_output=screen) - - if (stat/=0 .or. .not.success) then - call syntax_error(error,'local INTEL MPI library does not support -show') - return - end if - - ! MPICH reports the full command including the compiler name. Remove it if so + case (MPI_TYPE_MPICH,MPI_TYPE_INTEL) + ! These libraries report the full command including the compiler name. Remove it if so call remove_new_lines(screen) call split(screen%s,tokens) ! Remove trailing compiler name screen%s = screen%s(len_trim(tokens(1))+1:) - case default - - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) + call fatal_error(error,'invalid MPI library type') return - end select ! Get a list of additional linker flags case ('link') select case (mpilib) - case (MPI_TYPE_OPENMPI) + case (MPI_TYPE_OPENMPI); cmdstr = string_t('--showme:link') + case (MPI_TYPE_MPICH); cmdstr = string_t('-link-info') + case default + call fatal_error(error,unsupported_msg) + return + end select - ! --showme:link returns the linker command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('--showme:link')],verbose=verbose, & - exitcode=stat,cmd_success=success,screen_output=screen) + call run_mpi_wrapper(wrapper,[cmdstr],verbose=verbose, & + exitcode=stat,cmd_success=success,screen_output=screen) - if (stat/=0 .or. .not.success) then - call syntax_error(error,'local OpenMPI library does not support --showme:link') - return - end if + if (stat/=0 .or. .not.success) then + call syntax_error(error,'local '//MPI_TYPE_NAME(mpilib)//& + ' library wrapper does not support flag '//cmdstr%s) + return + end if + select case (mpilib) + case (MPI_TYPE_OPENMPI) call remove_new_lines(screen) - - !> Address OpenMPI wrapper bug - - case (MPI_TYPE_MPICH) - - call run_mpi_wrapper(wrapper,[string_t('-link-info')],verbose=verbose, & - exitcode=stat,cmd_success=success,screen_output=screen) - - if (stat/=0 .or. .not.success) then - call syntax_error(error,'local MPICH library does not support -link-info') - return - end if - ! MPICH reports the full command including the compiler name. Remove it if so call remove_new_lines(screen) call split(screen%s,tokens) ! Remove trailing compiler name screen%s = screen%s(len_trim(tokens(1))+1:) - case default - - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) + call fatal_error(error,unsupported_msg) return - end select ! Get a list of MPI library directories @@ -1512,7 +1462,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) case default - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) + call fatal_error(error,unsupported_msg) return end select @@ -1522,21 +1472,16 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) select case (mpilib) case (MPI_TYPE_OPENMPI) - ! --showme:command returns the build command of this wrapper call run_mpi_wrapper(wrapper,[string_t('--showme:incdirs')],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) - if (stat/=0 .or. .not.success) then call syntax_error(error,'local OpenMPI library does not support --showme:incdirs') return end if - case default - - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) + call fatal_error(error,unsupported_msg) return - end select call remove_new_lines(screen) @@ -1558,10 +1503,6 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) call remove_new_lines(screen) end if - ! Extract version - screen = extract_version_text(screen%s,'OpenMPI library',error) - if (allocated(error)) return - case (MPI_TYPE_MPICH) !> MPICH offers command "mpichversion" in the same system folder as the MPI wrappers. @@ -1587,11 +1528,6 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) if (stat/=0 .or. .not.success) then call syntax_error(error,'cannot retrieve MPICH library version from ') return - else - - screen = extract_version_text(screen%s,'MPICH library',error) - if (allocated(error)) return - end if case (MPI_TYPE_INTEL) @@ -1607,17 +1543,17 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) call remove_new_lines(screen) end if - ! Extract version - screen = extract_version_text(screen%s,'INTEL MPI library',error) - if (allocated(error)) return - case default - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) + call fatal_error(error,unsupported_msg) return end select + ! Extract version + screen = extract_version_text(screen%s,MPI_TYPE_NAME(mpilib)//' library',error) + if (allocated(error)) return + ! Get path to the MPI runner command case ('runner') @@ -1625,7 +1561,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) case (MPI_TYPE_OPENMPI,MPI_TYPE_MPICH,MPI_TYPE_MSMPI,MPI_TYPE_INTEL) call get_mpi_runner(screen,verbose,error) case default - call fatal_error(error,'the MPI library of wrapper '//wrapper%s//' does not support task '//trim(command)) + call fatal_error(error,unsupported_msg) return end select From 08ed7e69c3206a170e7f09f7d1d6d54c760b5ed7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 08:30:36 +0200 Subject: [PATCH 157/304] regex version: move to `fpm_versioning` --- src/fpm/versioning.f90 | 34 ++++++++++++++++++++++++++++++++++ src/fpm_meta.f90 | 38 +++----------------------------------- 2 files changed, 37 insertions(+), 35 deletions(-) diff --git a/src/fpm/versioning.f90 b/src/fpm/versioning.f90 index 4c7c01712a..b1da46a960 100644 --- a/src/fpm/versioning.f90 +++ b/src/fpm/versioning.f90 @@ -5,6 +5,7 @@ module fpm_versioning private public :: version_t, new_version + public :: regex_version_from_text type :: version_t @@ -390,5 +391,38 @@ elemental function match(lhs, rhs) end function match + ! Extract canonical version flags "1.0.0" or "1.0" as the first instance inside a text + ! (whatever long) using regex + type(string_t) function regex_version_from_text(text,what,error) result(ver) + character(*), intent(in) :: text + character(*), intent(in) :: what + type(error_t), allocatable, intent(out) :: error + + integer :: ire, length + + if (len_trim(text)<=0) then + call syntax_error(error,'cannot retrieve '//what//' version: empty input string') + return + end if + + ! Extract 3-sized version "1.0.4" + ire = regex(text,'\d+\.\d+\.\d+',length=length) + if (ire>0 .and. length>0) then + ! Parse version into the object (this should always work) + ver = string_t(text(ire:ire+length-1)) + else + + ! Try 2-sized version "1.0" + ire = regex(text,'\d+\.\d+',length=length) + + if (ire>0 .and. length>0) then + ver = string_t(text(ire:ire+length-1)) + else + call syntax_error(error,'cannot retrieve '//what//' version.') + end if + + end if + + end function regex_version_from_text end module fpm_versioning diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index bf3efcf54f..c46b75853b 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -23,7 +23,7 @@ module fpm_meta use fpm_manifest, only: package_config_t use fpm_environment, only: get_env,os_is_unix use fpm_filesystem, only: run, get_temp_filename, getline, exists, canon_path, is_dir -use fpm_versioning, only: version_t, new_version +use fpm_versioning, only: version_t, new_version, regex_version_from_text use fpm_os, only: get_absolute_path use iso_fortran_env, only: stdout => output_unit use regex_module, only: regex @@ -867,7 +867,7 @@ subroutine compiler_get_version(self,version,is_msys2,error) ! Check if this gcc is from the MSYS2 project is_msys2 = index(screen_output,'MSYS2')>0 - ver = extract_version_text(screen_output,self%fc//' compiler',error) + ver = regex_version_from_text(screen_output,self%fc//' compiler',error) if (allocated(error)) return ! Extract version @@ -1551,7 +1551,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) end select ! Extract version - screen = extract_version_text(screen%s,MPI_TYPE_NAME(mpilib)//' library',error) + screen = regex_version_from_text(screen%s,MPI_TYPE_NAME(mpilib)//' library',error) if (allocated(error)) return ! Get path to the MPI runner command @@ -1605,36 +1605,4 @@ subroutine remove_new_lines(string) end subroutine remove_new_lines -type(string_t) function extract_version_text(text,what,error) result(ver) - character(*), intent(in) :: text - character(*), intent(in) :: what - type(error_t), allocatable, intent(out) :: error - - integer :: ire, length - - if (len_trim(text)<=0) then - call syntax_error(error,'cannot retrieve '//what//' version: empty input string') - return - end if - - ! Extract 3-sized version "1.0.4" - ire = regex(text,'\d+\.\d+\.\d+',length=length) - if (ire>0 .and. length>0) then - ! Parse version into the object (this should always work) - ver = string_t(text(ire:ire+length-1)) - else - - ! Try 2-sized version "1.0" - ire = regex(text,'\d+\.\d+',length=length) - - if (ire>0 .and. length>0) then - ver = string_t(text(ire:ire+length-1)) - else - call syntax_error(error,'cannot retrieve '//what//' version.') - end if - - end if - -end function extract_version_text - end module fpm_meta From cd2a02f3fe0ff5f394957ebc0991c188deb09de4 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 08:38:02 +0200 Subject: [PATCH 158/304] remove_newline_characters: move to `fpm_strings` --- src/fpm/versioning.f90 | 2 ++ src/fpm_meta.f90 | 50 ++++++++---------------------------------- src/fpm_strings.f90 | 42 ++++++++++++++++++++++++++++++++++- 3 files changed, 52 insertions(+), 42 deletions(-) diff --git a/src/fpm/versioning.f90 b/src/fpm/versioning.f90 index b1da46a960..d1e130a2c3 100644 --- a/src/fpm/versioning.f90 +++ b/src/fpm/versioning.f90 @@ -1,6 +1,8 @@ !> Implementation of versioning data for comparing packages module fpm_versioning use fpm_error, only : error_t, syntax_error + use fpm_strings, only: string_t + use regex_module, only: regex implicit none private diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index c46b75853b..e78fe13181 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -13,7 +13,7 @@ !> !> module fpm_meta -use fpm_strings, only: string_t, len_trim +use fpm_strings, only: string_t, len_trim, remove_newline_characters use fpm_error, only: error_t, fatal_error, syntax_error, fpm_stop use fpm_compiler use fpm_model @@ -26,7 +26,6 @@ module fpm_meta use fpm_versioning, only: version_t, new_version, regex_version_from_text use fpm_os, only: get_absolute_path use iso_fortran_env, only: stdout => output_unit -use regex_module, only: regex implicit none @@ -1399,10 +1398,10 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) select case (mpilib) case (MPI_TYPE_OPENMPI) ! This library reports the compiler name only - call remove_new_lines(screen) + call remove_newline_characters(screen) case (MPI_TYPE_MPICH,MPI_TYPE_INTEL) ! These libraries report the full command including the compiler name. Remove it if so - call remove_new_lines(screen) + call remove_newline_characters(screen) call split(screen%s,tokens) ! Remove trailing compiler name screen%s = screen%s(len_trim(tokens(1))+1:) @@ -1433,10 +1432,10 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) select case (mpilib) case (MPI_TYPE_OPENMPI) - call remove_new_lines(screen) + call remove_newline_characters(screen) case (MPI_TYPE_MPICH) ! MPICH reports the full command including the compiler name. Remove it if so - call remove_new_lines(screen) + call remove_newline_characters(screen) call split(screen%s,tokens) ! Remove trailing compiler name screen%s = screen%s(len_trim(tokens(1))+1:) @@ -1484,7 +1483,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) return end select - call remove_new_lines(screen) + call remove_newline_characters(screen) ! Retrieve library version case ('version') @@ -1500,7 +1499,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) call syntax_error(error,'local OpenMPI library does not support --showme:version') return else - call remove_new_lines(screen) + call remove_newline_characters(screen) end if case (MPI_TYPE_MPICH) @@ -1515,7 +1514,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) if (stat/=0 .or. .not.success) then call run_mpi_wrapper(wrapper,[string_t('-v')],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) - call remove_new_lines(screen) + call remove_newline_characters(screen) endif ! Third option: mpiexec --version @@ -1540,7 +1539,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) call syntax_error(error,'local INTEL MPI library does not support -v') return else - call remove_new_lines(screen) + call remove_newline_characters(screen) end if case default @@ -1574,35 +1573,4 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) end function mpi_wrapper_query -! Remove all new line characters from the current string -subroutine remove_new_lines(string) - type(string_t), intent(inout) :: string - - integer :: feed,length - - if (.not.allocated(string%s)) return - - - length = len(string%s) - feed = scan(string%s,new_line('a')) - - do while (length>0 .and. feed>0) - - if (length==1) then - string = string_t("") - elseif (feed==1) then - string%s = string%s(2:length) - elseif (feed==length) then - string%s = string%s(1:length-1) - else - string%s = string%s(1:feed-1)//string%s(feed+1:length) - end if - - length = len(string%s) - feed = scan(string%s,new_line('a')) - - end do - -end subroutine remove_new_lines - end module fpm_meta diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index f8dc4e6daf..404a7dc6f5 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -43,7 +43,7 @@ module fpm_strings public :: to_fortran_name, is_fortran_name public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a public :: replace, resize, str, join, glob -public :: notabs +public :: notabs, remove_newline_characters !> Module naming public :: is_valid_module_name, is_valid_module_prefix, & @@ -1219,6 +1219,46 @@ logical function has_valid_standard_prefix(module_name,package_name) result(vali end function has_valid_standard_prefix +! Remove all new line characters from the current string, replace them with spaces +subroutine remove_newline_characters(string) + type(string_t), intent(inout) :: string + + integer :: feed,length + + character(*), parameter :: CRLF = new_line('a')//achar(13) + character(*), parameter :: SPACE = ' ' + + if (.not.allocated(string%s)) return + + + length = len(string%s) + feed = scan(string%s,CRLF) + + do while (length>0 .and. feed>0) + + ! Remove heading + if (length==1) then + string = string_t("") + + elseif (feed==1) then + string%s = string%s(2:length) + + ! Remove trailing + elseif (feed==length) then + string%s = string%s(1:length-1) + + ! In between: replace with space + else + string%s(feed:feed) = SPACE + end if + + length = len(string%s) + feed = scan(string%s,CRLF) + + end do + +end subroutine remove_newline_characters + !> !!### NAME !! notabs(3f) - [fpm_strings:NONALPHA] expand tab characters From da1a585358d21542bcafff68f2b67700d97ece33 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 08:42:43 +0200 Subject: [PATCH 159/304] test macOS only --- .github/workflows/meta.yml | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index d88ffc2501..9538fa0789 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -29,17 +29,18 @@ jobs: fail-fast: false matrix: include: - - os: ubuntu-latest - mpi: intel - - os: ubuntu-latest + # - os: ubuntu-latest + # mpi: intel + # - os: ubuntu-latest + # mpi: openmpi + # - os: ubuntu-latest + # mpi: mpich + # - #os: windows-latest + # mpi: msmpi + - os: macos-latest mpi: openmpi - - os: ubuntu-latest - mpi: mpich - - os: windows-latest - mpi: msmpi - # env: - # FC: gfortran - # GCC_V: ${{ matrix.gcc_v }} + env: + FC: gfortran steps: - name: Checkout code From a0f0f59cec0978c56134a73581499a84809e7be0 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 08:51:31 +0200 Subject: [PATCH 160/304] env syntax --- .github/workflows/meta.yml | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 9538fa0789..6aef320a25 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -39,8 +39,6 @@ jobs: # mpi: msmpi - os: macos-latest mpi: openmpi - env: - FC: gfortran steps: - name: Checkout code @@ -132,9 +130,9 @@ jobs: - name: (macOS) Install Homebrew gfortran if: contains(matrix.os, 'macos') run: | - brew install gcc@${GCC_V} - ln -s /usr/local/bin/gfortran-${GCC_V} /usr/local/bin/gfortran - which gfortran-${GCC_V} + brew install gcc@${{ env.GCC_V }} + ln -s /usr/local/bin/gfortran-${{ env.GCC_V }} /usr/local/bin/gfortran + which gfortran-${{ env.GCC_V }} which gfortran - name: (macOS) Install homebrew MPICH @@ -145,7 +143,7 @@ jobs: - name: (macOS) Install homebrew OpenMPI if: contains(matrix.mpi,'openmpi') && contains(matrix.os,'macos') run: | - brew install --cc=gcc-${GCC_V} openmpi + brew install --cc=gcc-${{ env.GCC_V}} openmpi # Phase 1: Bootstrap fpm with existing version - name: Install fpm From fc580e3172ce747017420ed7b38f8798cd6e94b2 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 08:55:18 +0200 Subject: [PATCH 161/304] restore MPICH+macOS, set gcc for C/C++ --- .github/workflows/meta.yml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 6aef320a25..11e0038239 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -39,6 +39,8 @@ jobs: # mpi: msmpi - os: macos-latest mpi: openmpi + - os: macos-latest + mpi: mpich steps: - name: Checkout code @@ -239,6 +241,14 @@ jobs: echo "FPM_CC=icc" >> $GITHUB_ENV echo "FPM_CXX=icpc" >> $GITHUB_ENV + - name: (macOS) Use gcc/g++ instead of Clang for C/C++ + if: contains(matrix.os,'macOS') + shell: bash + run: | + echo "FPM_FC=gfortran" >> $GITHUB_ENV + echo "FPM_CC=gcc-{{ env.GCC_V }}" >> $GITHUB_ENV + echo "FPM_CXX=g++-{{ env.GCC_V }}" >> $GITHUB_ENV + - name: Run metapackage tests using the release version shell: bash run: | From d9aa848bfbe32d9f7b35e8c50176f31588c7556b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 08:56:30 +0200 Subject: [PATCH 162/304] remove link gfortran-10 --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 11e0038239..fcdb87bd5e 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -133,7 +133,7 @@ jobs: if: contains(matrix.os, 'macos') run: | brew install gcc@${{ env.GCC_V }} - ln -s /usr/local/bin/gfortran-${{ env.GCC_V }} /usr/local/bin/gfortran + # ln -s /usr/local/bin/gfortran-${{ env.GCC_V }} /usr/local/bin/gfortran which gfortran-${{ env.GCC_V }} which gfortran From 8a273e7938a9e36d9efc1ed1a7a1f7ba2aa08a2a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 08:57:18 +0200 Subject: [PATCH 163/304] print version --- .github/workflows/meta.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index fcdb87bd5e..6e9c5ca468 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -136,6 +136,8 @@ jobs: # ln -s /usr/local/bin/gfortran-${{ env.GCC_V }} /usr/local/bin/gfortran which gfortran-${{ env.GCC_V }} which gfortran + gfortran-${{ env.GCC_V }} --version + gfortran --version - name: (macOS) Install homebrew MPICH if: contains(matrix.mpi,'mpich') && contains(matrix.os,'macos') From c1cfbd5f559b1840c47cbe5a7c30f3d342fa2731 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 09:01:26 +0200 Subject: [PATCH 164/304] use all gcc-13 compilers --- .github/workflows/meta.yml | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 6e9c5ca468..68170ec0ec 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -19,7 +19,7 @@ env: HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: "ON" HOMEBREW_NO_GITHUB_API: "ON" HOMEBREW_NO_INSTALL_CLEANUP: "ON" - GCC_V: "10" + GCC_V: "13" jobs: @@ -133,11 +133,8 @@ jobs: if: contains(matrix.os, 'macos') run: | brew install gcc@${{ env.GCC_V }} - # ln -s /usr/local/bin/gfortran-${{ env.GCC_V }} /usr/local/bin/gfortran which gfortran-${{ env.GCC_V }} which gfortran - gfortran-${{ env.GCC_V }} --version - gfortran --version - name: (macOS) Install homebrew MPICH if: contains(matrix.mpi,'mpich') && contains(matrix.os,'macos') @@ -247,7 +244,7 @@ jobs: if: contains(matrix.os,'macOS') shell: bash run: | - echo "FPM_FC=gfortran" >> $GITHUB_ENV + echo "FPM_FC=gfortran-{{ env.GCC_V }}" >> $GITHUB_ENV echo "FPM_CC=gcc-{{ env.GCC_V }}" >> $GITHUB_ENV echo "FPM_CXX=g++-{{ env.GCC_V }}" >> $GITHUB_ENV From c966c3d90a0d521ae4ab73a1497f7fbff174bd21 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 09:02:32 +0200 Subject: [PATCH 165/304] missing $ --- .github/workflows/meta.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 68170ec0ec..99bb0211ae 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -244,9 +244,9 @@ jobs: if: contains(matrix.os,'macOS') shell: bash run: | - echo "FPM_FC=gfortran-{{ env.GCC_V }}" >> $GITHUB_ENV - echo "FPM_CC=gcc-{{ env.GCC_V }}" >> $GITHUB_ENV - echo "FPM_CXX=g++-{{ env.GCC_V }}" >> $GITHUB_ENV + echo "FPM_FC=gfortran-${{ env.GCC_V }}" >> $GITHUB_ENV + echo "FPM_CC=gcc-${{ env.GCC_V }}" >> $GITHUB_ENV + echo "FPM_CXX=g++-${{ env.GCC_V }}" >> $GITHUB_ENV - name: Run metapackage tests using the release version shell: bash From 4766e1b9cb2c579ee5414b609d9336673849d4db Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 09:06:45 +0200 Subject: [PATCH 166/304] get_dos_path: move to `fpm_filesystem` --- src/fpm_filesystem.F90 | 65 +++++++++++++++++++++++++++++++++++++++++- src/fpm_meta.f90 | 65 +----------------------------------------- 2 files changed, 65 insertions(+), 65 deletions(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index c7b12a8b5e..91a8124889 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -15,7 +15,7 @@ module fpm_filesystem 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 + execute_and_read_output, get_dos_path integer, parameter :: LINE_BUFFER_LEN = 1000 #ifndef FPM_BOOTSTRAP @@ -1082,4 +1082,67 @@ subroutine get_tmp_directory(tmp_dir, error) call fatal_error(error, "Couldn't determine system temporary directory.") end + !> Ensure a windows path is converted to a DOS path if it contains spaces + function get_dos_path(path,error) + character(len=*), intent(in) :: path + type(error_t), allocatable, intent(out) :: error + character(len=:), allocatable :: get_dos_path + + character(:), allocatable :: redirect,screen_output,line + integer :: stat,cmdstat,iunit,last + + ! Non-Windows OS + if (get_os_type()/=OS_WINDOWS) then + get_dos_path = path + return + end if + + ! Trim path first + get_dos_path = trim(path) + + !> No need to convert if there are no spaces + has_spaces: if (scan(get_dos_path,' ')>0) then + + redirect = get_temp_filename() + call execute_command_line('cmd /c for %A in ("'//path//'") do @echo %~sA >'//redirect//' 2>&1',& + exitstat=stat,cmdstat=cmdstat) + + !> Read screen output + command_OK: if (cmdstat==0 .and. stat==0) then + + allocate(character(len=0) :: screen_output) + open(newunit=iunit,file=redirect,status='old',iostat=stat) + if (stat == 0)then + + do + call getline(iunit, line, stat) + if (stat /= 0) exit + screen_output = screen_output//line//' ' + end do + + ! Close and delete file + close(iunit,status='delete') + + else + call fatal_error(error,'cannot read temporary file from successful DOS path evaluation') + return + endif + + else command_OK + + call fatal_error(error,'unsuccessful Windows->DOS path command') + return + + end if command_OK + + get_dos_path = trim(adjustl(screen_output)) + + endif has_spaces + + !> Ensure there are no trailing slashes + last = len_trim(get_dos_path) + if (last>1 .and. get_dos_path(last:last)=='/' .or. get_dos_path(last:last)=='\') get_dos_path = get_dos_path(1:last-1) + + end function get_dos_path + end module fpm_filesystem diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index e78fe13181..4d10a158b9 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -22,7 +22,7 @@ module fpm_meta use fpm_git, only : git_target_branch use fpm_manifest, only: package_config_t use fpm_environment, only: get_env,os_is_unix -use fpm_filesystem, only: run, get_temp_filename, getline, exists, canon_path, is_dir +use fpm_filesystem, only: run, get_temp_filename, getline, exists, canon_path, is_dir, get_dos_path use fpm_versioning, only: version_t, new_version, regex_version_from_text use fpm_os, only: get_absolute_path use iso_fortran_env, only: stdout => output_unit @@ -880,69 +880,6 @@ subroutine compiler_get_version(self,version,is_msys2,error) end subroutine compiler_get_version -!> Ensure a windows path is converted to a DOS path if it contains spaces -function get_dos_path(path,error) - character(len=*), intent(in) :: path - type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: get_dos_path - - character(:), allocatable :: redirect,screen_output,line - integer :: stat,cmdstat,iunit,last - - ! Non-Windows OS - if (get_os_type()/=OS_WINDOWS) then - get_dos_path = path - return - end if - - ! Trim path first - get_dos_path = trim(path) - - !> No need to convert if there are no spaces - has_spaces: if (scan(get_dos_path,' ')>0) then - - redirect = get_temp_filename() - call execute_command_line('cmd /c for %A in ("'//path//'") do @echo %~sA >'//redirect//' 2>&1',& - exitstat=stat,cmdstat=cmdstat) - - !> Read screen output - command_OK: if (cmdstat==0 .and. stat==0) then - - allocate(character(len=0) :: screen_output) - open(newunit=iunit,file=redirect,status='old',iostat=stat) - if (stat == 0)then - - do - call getline(iunit, line, stat) - if (stat /= 0) exit - screen_output = screen_output//line//' ' - end do - - ! Close and delete file - close(iunit,status='delete') - - else - call fatal_error(error,'cannot read temporary file from successful DOS path evaluation') - return - endif - - else command_OK - - call fatal_error(error,'unsuccessful Windows->DOS path command') - return - - end if command_OK - - get_dos_path = trim(adjustl(screen_output)) - - endif has_spaces - - !> Ensure there are no trailing slashes - last = len_trim(get_dos_path) - if (last>1 .and. get_dos_path(last:last)=='/' .or. get_dos_path(last:last)=='\') get_dos_path = get_dos_path(1:last-1) - -end function get_dos_path - !> Initialize an MPI metapackage from a valid wrapper command ('mpif90', etc...) subroutine init_mpi_from_wrappers(this,compiler,mpilib,fort_wrapper,c_wrapper,cxx_wrapper,error) class(metapackage_t), intent(inout) :: this From 9184cbfd49e7df312469a3ebf17bb90d743803cd Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 09:10:39 +0200 Subject: [PATCH 167/304] dummy links to gcc-9 for bootstrapping --- .github/workflows/meta.yml | 13 ++++++++++++- src/fpm_filesystem.F90 | 2 +- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 99bb0211ae..39a38151da 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -135,6 +135,17 @@ jobs: brew install gcc@${{ env.GCC_V }} which gfortran-${{ env.GCC_V }} which gfortran + # Backport gfortran shared libraries to version 9 folder. This is necessary because all macOS releases of fpm + # have these paths hardcoded in the executable (no PIC?). As the gcc ABIs have not changed from 9 to 10, we + # can just create symbolic links for now. This can be removed when an updated fpm release is built with gcc-10 + mkdir /usr/local/opt/gcc@9 + mkdir /usr/local/opt/gcc@9/lib + mkdir /usr/local/opt/gcc@9/lib/gcc + mkdir /usr/local/opt/gcc@9/lib/gcc/9 + mkdir /usr/local/lib/gcc/9 + ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libquadmath.0.dylib /usr/local/opt/gcc@9/lib/gcc/9/libquadmath.0.dylib + ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libgfortran.5.dylib /usr/local/opt/gcc@9/lib/gcc/9/libgfortran.5.dylib + ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib /usr/local/lib/gcc/9/libgcc_s.1.dylib - name: (macOS) Install homebrew MPICH if: contains(matrix.mpi,'mpich') && contains(matrix.os,'macos') @@ -144,7 +155,7 @@ jobs: - name: (macOS) Install homebrew OpenMPI if: contains(matrix.mpi,'openmpi') && contains(matrix.os,'macos') run: | - brew install --cc=gcc-${{ env.GCC_V}} openmpi + brew install --cc=gcc-${{ env.GCC_V }} openmpi # Phase 1: Bootstrap fpm with existing version - name: Install fpm diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 91a8124889..d2ffb61f0c 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -1082,7 +1082,7 @@ subroutine get_tmp_directory(tmp_dir, error) call fatal_error(error, "Couldn't determine system temporary directory.") end - !> Ensure a windows path is converted to a DOS path if it contains spaces + !> Ensure a windows path is converted to an 8.3 DOS path if it contains spaces function get_dos_path(path,error) character(len=*), intent(in) :: path type(error_t), allocatable, intent(out) :: error From 0611616e5af16cd4a289721b59fbe893f7d77992 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 09:21:27 +0200 Subject: [PATCH 168/304] fpm bootstrap needs gcc-10 --- .github/workflows/meta.yml | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 39a38151da..9a63ea4237 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -135,17 +135,16 @@ jobs: brew install gcc@${{ env.GCC_V }} which gfortran-${{ env.GCC_V }} which gfortran - # Backport gfortran shared libraries to version 9 folder. This is necessary because all macOS releases of fpm - # have these paths hardcoded in the executable (no PIC?). As the gcc ABIs have not changed from 9 to 10, we - # can just create symbolic links for now. This can be removed when an updated fpm release is built with gcc-10 - mkdir /usr/local/opt/gcc@9 - mkdir /usr/local/opt/gcc@9/lib - mkdir /usr/local/opt/gcc@9/lib/gcc - mkdir /usr/local/opt/gcc@9/lib/gcc/9 - mkdir /usr/local/lib/gcc/9 - ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libquadmath.0.dylib /usr/local/opt/gcc@9/lib/gcc/9/libquadmath.0.dylib - ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libgfortran.5.dylib /usr/local/opt/gcc@9/lib/gcc/9/libgfortran.5.dylib - ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib /usr/local/lib/gcc/9/libgcc_s.1.dylib + # Backport gfortran shared libraries to version 10 folder. This is necessary because all macOS releases of fpm + # have these paths hardcoded in the executable (no PIC?). Current bootstrap version 0.8.0 has gcc-10 + mkdir /usr/local/opt/gcc@10 + mkdir /usr/local/opt/gcc@10/lib + mkdir /usr/local/opt/gcc@10/lib/gcc + mkdir /usr/local/opt/gcc@10/lib/gcc/10 + mkdir /usr/local/lib/gcc/10 + ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libquadmath.0.dylib /usr/local/opt/gcc@10/lib/gcc/10/libquadmath.0.dylib + ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libgfortran.5.dylib /usr/local/opt/gcc@10/lib/gcc/10/libgfortran.5.dylib + ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib - name: (macOS) Install homebrew MPICH if: contains(matrix.mpi,'mpich') && contains(matrix.os,'macos') From 3d2f24218feb21df23d78e65c7b22d3b1f9f7215 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 09:25:23 +0200 Subject: [PATCH 169/304] remove metapackages from the standard tests --- ci/run_tests.sh | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index bc3de03aee..b0e769b73e 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -201,26 +201,6 @@ EXIT_CODE=0 test $EXIT_CODE -eq 1 popd - -# Test metapackages -pushd metapackage_openmp -EXIT_CODE=0 -"$fpm" build || EXIT_CODE=$? -test $EXIT_CODE -eq 0 -EXIT_CODE=0 -"$fpm" run || EXIT_CODE=$? -test $EXIT_CODE -eq 0 -popd - -pushd metapackage_stdlib -EXIT_CODE=0 -"$fpm" build || EXIT_CODE=$? -test $EXIT_CODE -eq 0 -EXIT_CODE=0 -"$fpm" run || EXIT_CODE=$? -test $EXIT_CODE -eq 0 -popd - # test dependency priority pushd dependency_priority From 36770e555609316cf433d48801aeab9a538a4b8b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 09:29:42 +0200 Subject: [PATCH 170/304] restore other os/MPI configs --- .github/workflows/meta.yml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 9a63ea4237..aae8e5a2b7 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -29,14 +29,14 @@ jobs: fail-fast: false matrix: include: - # - os: ubuntu-latest - # mpi: intel - # - os: ubuntu-latest - # mpi: openmpi - # - os: ubuntu-latest - # mpi: mpich - # - #os: windows-latest - # mpi: msmpi + - os: ubuntu-latest + mpi: intel + - os: ubuntu-latest + mpi: openmpi + - os: ubuntu-latest + mpi: mpich + - os: windows-latest + mpi: msmpi - os: macos-latest mpi: openmpi - os: macos-latest From 8a3e37512f35b977963c16d3f2fa11def27c37ee Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 09:32:43 +0200 Subject: [PATCH 171/304] gcc-13 not available on Ubuntu-latest --- .github/workflows/meta.yml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index aae8e5a2b7..4add850068 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -31,10 +31,16 @@ jobs: include: - os: ubuntu-latest mpi: intel + env: + GCC_V: "10" - os: ubuntu-latest mpi: openmpi + env: + GCC_V: "10" - os: ubuntu-latest mpi: mpich + env: + GCC_V: "10" - os: windows-latest mpi: msmpi - os: macos-latest From beab3561b5dc8612039c762af425d501bfdf8160 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 09:39:17 +0200 Subject: [PATCH 172/304] switch GCC_V --- .github/workflows/meta.yml | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 4add850068..64e4cba993 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -19,7 +19,6 @@ env: HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: "ON" HOMEBREW_NO_GITHUB_API: "ON" HOMEBREW_NO_INSTALL_CLEANUP: "ON" - GCC_V: "13" jobs: @@ -31,16 +30,10 @@ jobs: include: - os: ubuntu-latest mpi: intel - env: - GCC_V: "10" - os: ubuntu-latest mpi: openmpi - env: - GCC_V: "10" - os: ubuntu-latest mpi: mpich - env: - GCC_V: "10" - os: windows-latest mpi: msmpi - os: macos-latest @@ -52,6 +45,16 @@ jobs: - name: Checkout code uses: actions/checkout@v1 + - name: (Ubuntu) setup gcc version + if: contains(matrix.os,'ubuntu') + run: | + echo "GCC_V=10" >> $GITHUB_ENV + + - name: (macOS) setup gcc version + if: contains(matrix.os,'macos') + run: | + echo "GCC_V=13" >> $GITHUB_ENV + - uses: msys2/setup-msys2@v2 if: contains(matrix.os,'windows') with: From b695b70ba0abde2256b937bdd0c844eb0965e492 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 09:43:30 +0200 Subject: [PATCH 173/304] Windows: also check in the default Microsoft MPI folder --- src/fpm_meta.f90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 4d10a158b9..0f30ff1ff2 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -581,6 +581,15 @@ logical function msmpi_init(this,compiler,error) result(found) if (allocated(error)) return endif + ! Do a third attempt: search for mpiexec.exe in the default location + if (len_trim(bindir)<=0 .or. .not.exists(bindir) .or. allocated(error)) then + windir = get_dos_path('C:\Program Files\Microsoft MPI\Bin\mpiexec.exe',error) + + if (.not.allocated(error)) & + call find_command_location(windir,bindir,verbose=verbose,error=error) + + endif + if (allocated(error) .or. .not.exists(bindir)) then call fatal_error(error,'MS-MPI error: MS-MPI Runtime directory is missing. '//& 'check environment variable %MSMPI_BIN% or that the folder is in %PATH%.') From 750f0d243d0fc2848e56e2b77823e161d8382210 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 18:32:50 +0200 Subject: [PATCH 174/304] Implement wildcard `"*"` --- example_packages/metapackage_mpi/fpm.toml | 2 +- example_packages/metapackage_mpi_c/fpm.toml | 2 +- example_packages/metapackage_mpi_cpp/fpm.toml | 2 +- example_packages/metapackage_openmp/fpm.toml | 2 +- example_packages/metapackage_stdlib/fpm.toml | 2 +- src/fpm/manifest/meta.f90 | 137 +++++++++++++++--- src/fpm_meta.f90 | 8 +- 7 files changed, 126 insertions(+), 29 deletions(-) diff --git a/example_packages/metapackage_mpi/fpm.toml b/example_packages/metapackage_mpi/fpm.toml index 933e9568cc..fcd1b7e2d5 100644 --- a/example_packages/metapackage_mpi/fpm.toml +++ b/example_packages/metapackage_mpi/fpm.toml @@ -13,7 +13,7 @@ implicit-typing = true auto-executables = true [dependencies] -mpi = true +mpi = "*" [install] library = false diff --git a/example_packages/metapackage_mpi_c/fpm.toml b/example_packages/metapackage_mpi_c/fpm.toml index ffbb88a139..feb1c0297a 100644 --- a/example_packages/metapackage_mpi_c/fpm.toml +++ b/example_packages/metapackage_mpi_c/fpm.toml @@ -14,7 +14,7 @@ implicit-typing=true implicit-external=true [dependencies] -mpi = true +mpi = "*" [install] library = false diff --git a/example_packages/metapackage_mpi_cpp/fpm.toml b/example_packages/metapackage_mpi_cpp/fpm.toml index 5d236bcc89..7edb3cbd23 100644 --- a/example_packages/metapackage_mpi_cpp/fpm.toml +++ b/example_packages/metapackage_mpi_cpp/fpm.toml @@ -14,7 +14,7 @@ implicit-typing=true implicit-external=true [dependencies] -mpi = true +mpi = "*" [install] library = false diff --git a/example_packages/metapackage_openmp/fpm.toml b/example_packages/metapackage_openmp/fpm.toml index 9638da7b42..442f12b84f 100644 --- a/example_packages/metapackage_openmp/fpm.toml +++ b/example_packages/metapackage_openmp/fpm.toml @@ -11,7 +11,7 @@ auto-tests = true auto-examples = true [dependencies] -openmp = true +openmp = "*" [install] library = false diff --git a/example_packages/metapackage_stdlib/fpm.toml b/example_packages/metapackage_stdlib/fpm.toml index b90849bd50..8932b23b2e 100644 --- a/example_packages/metapackage_stdlib/fpm.toml +++ b/example_packages/metapackage_stdlib/fpm.toml @@ -7,7 +7,7 @@ auto-tests = true auto-examples = true [dependencies] -stdlib = true +stdlib = "*" [install] library = false diff --git a/src/fpm/manifest/meta.f90 b/src/fpm/manifest/meta.f90 index 5a72c96db8..9016932b7c 100644 --- a/src/fpm/manifest/meta.f90 +++ b/src/fpm/manifest/meta.f90 @@ -17,24 +17,131 @@ module fpm_manifest_metapackages public :: metapackage_config_t, new_meta_config, is_meta_package + + !> Configuration data for a single metapackage request + type :: metapackage_request_t + + !> Request flag + logical :: on = .false. + + !> Metapackage name + character(len=:), allocatable :: name + + !> Version Specification string + character(len=:), allocatable :: version + + end type metapackage_request_t + + !> Configuration data for metapackages type :: metapackage_config_t !> Request MPI support - logical :: mpi = .false. + type(metapackage_request_t) :: mpi !> Request OpenMP support - logical :: openmp = .false. + type(metapackage_request_t) :: openmp !> Request stdlib support - logical :: stdlib = .false. - + type(metapackage_request_t) :: stdlib end type metapackage_config_t contains + !> Destroy a metapackage request + elemental subroutine request_destroy(self) + + !> Instance of the request + class(metapackage_request_t), intent(inout) :: self + + self%on = .false. + if (allocated(self%version)) deallocate(self%version) + if (allocated(self%name)) deallocate(self%name) + + end subroutine request_destroy + + !> Parse version string of a metapackage reques + subroutine request_parse(self, version_request, error) + + ! Instance of this metapackage + type(metapackage_request_t), intent(inout) :: self + + ! Parse version request + character(len=*), intent(in) :: version_request + + ! Error message + type(error_t), allocatable, intent(out) :: error + + ! wildcard = use any versions + if (version_request=="*") then + + ! Any version is OK + self%on = .true. + self%version = version_request + + else + + call fatal_error(error,'Value <'//version_request//'> for metapackage '//self%name//& + 'is not currently supported. Try "*" instead. ') + return + + end if + + end subroutine request_parse + + !> Construct a new metapackage request from the dependencies table + subroutine new_request(self, key, table, error) + + type(metapackage_request_t), intent(out) :: self + + !> The package name + character(len=*), intent(in) :: key + + !> Instance of the TOML data structure + type(toml_table), intent(inout) :: table + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + + integer :: stat,i + character(len=:), allocatable :: value + type(toml_key), allocatable :: keys(:) + + call request_destroy(self) + + !> Set name + self%name = key + if (.not.is_meta_package(key)) then + call fatal_error(error,"Error reading fpm.toml: <"//key//"> is not a valid metapackage name") + return + end if + + !> The toml table is not checked here because it already passed + !> the "new_dependencies" check + + call table%get_keys(keys) + + do i=1,size(keys) + if (keys(i)%key==key) then + call get_value(table, key, value) + if (.not. allocated(value)) then + call syntax_error(error, "Could not retrieve version string for metapackage key <"//key//">. Check syntax") + return + else + call request_parse(self, value, error) + return + endif + end if + end do + + ! Key is not present, metapackage not requested + return + + end subroutine new_request + !> Construct a new build configuration from a TOML data structure subroutine new_meta_config(self, table, error) @@ -51,24 +158,14 @@ subroutine new_meta_config(self, table, error) !> The toml table is not checked here because it already passed !> the "new_dependencies" check + call new_request(self%openmp, "openmp", table, error); + if (allocated(error)) return - call get_value(table, "openmp", self%openmp, .false., stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error,"Error while reading value for 'openmp' in fpm.toml, expecting logical") - return - end if - - call get_value(table, "stdlib", self%stdlib, .false., stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error,"Error while reading value for 'stdlib' in fpm.toml, expecting logical") - return - end if + call new_request(self%stdlib, "stdlib", table, error) + if (allocated(error)) return - call get_value(table, "mpi", self%mpi, .false., stat=stat) - if (stat /= toml_stat%success) then - call fatal_error(error,"Error while reading value for 'mpi' in fpm.toml, expecting logical") - return - end if + call new_request(self%mpi, "mpi", table, error) + if (allocated(error)) return end subroutine new_meta_config diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 0f30ff1ff2..ac2c7e0693 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -397,24 +397,24 @@ subroutine resolve_metapackage_model(model,package,settings,error) end if ! OpenMP - if (package%meta%openmp) then + if (package%meta%openmp%on) then call add_metapackage_model(model,package,settings,"openmp",error) if (allocated(error)) return endif ! stdlib - if (package%meta%stdlib) then + if (package%meta%stdlib%on) then call add_metapackage_model(model,package,settings,"stdlib",error) if (allocated(error)) return endif ! Stdlib is not 100% thread safe. print a warning to the user - if (package%meta%stdlib .and. package%meta%openmp) then + if (package%meta%stdlib%on .and. package%meta%openmp%on) then write(stdout,'(a)')' both openmp and stdlib requested: some functions may not be thread-safe!' end if ! MPI - if (package%meta%mpi) then + if (package%meta%mpi%on) then call add_metapackage_model(model,package,settings,"mpi",error) if (allocated(error)) return endif From 3ad42220118bb557c9b2d2b9a9798410ba98d25e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 19:47:10 +0200 Subject: [PATCH 175/304] set MSMPI_BIN --- .github/workflows/meta.yml | 6 ++++-- src/fpm_meta.f90 | 2 ++ 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 64e4cba993..41a336584c 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -113,7 +113,7 @@ jobs: - name: (Windows) download MS-MPI setup (SDK is from MSYS2) if: contains(matrix.os,'windows') - run: curl -L -O https://github.com/microsoft/Microsoft-MPI/releases/download/v10.1.1/msmpisetup.exe + run: curl -L -O https://github.com/microsoft/Microsoft-MPI/releases/download/v10.1.2/msmpisetup.exe - name: (Windows) Install mpiexec.exe (-force needed to bypass GUI on headless) if: contains(matrix.os,'windows') @@ -126,7 +126,9 @@ jobs: - name: (Windows) put MSMPI_BIN on PATH (where mpiexec is) if: contains(matrix.os,'windows') - run: echo "C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append + run: | + echo "C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append + echo "MSMPI_BIN=C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_ENV -Append - name: (Windows) Install MSYS2 msmpi package if: contains(matrix.os,'windows') diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index ac2c7e0693..cdebcbbe71 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -585,6 +585,8 @@ logical function msmpi_init(this,compiler,error) result(found) if (len_trim(bindir)<=0 .or. .not.exists(bindir) .or. allocated(error)) then windir = get_dos_path('C:\Program Files\Microsoft MPI\Bin\mpiexec.exe',error) + print *, 'windir=',windir + if (.not.allocated(error)) & call find_command_location(windir,bindir,verbose=verbose,error=error) From a707c000d1925f999f5d4fe5d9a73c6e202fcbbf Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 19:52:13 +0200 Subject: [PATCH 176/304] remove return --- src/fpm_meta.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index cdebcbbe71..0faa916d19 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -578,7 +578,6 @@ logical function msmpi_init(this,compiler,error) result(found) ! Do a second attempt: search for mpiexec.exe if (len_trim(bindir)<=0 .or. .not.exists(bindir)) then call find_command_location('mpiexec.exe',bindir,verbose=verbose,error=error) - if (allocated(error)) return endif ! Do a third attempt: search for mpiexec.exe in the default location From 40f2522a3eebc6caa08d6d7fd5664594d2739f5e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 3 May 2023 19:57:00 +0200 Subject: [PATCH 177/304] fix MS-MPI 10.1.2 link --- .github/workflows/meta.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 41a336584c..0b1ab30568 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -113,7 +113,8 @@ jobs: - name: (Windows) download MS-MPI setup (SDK is from MSYS2) if: contains(matrix.os,'windows') - run: curl -L -O https://github.com/microsoft/Microsoft-MPI/releases/download/v10.1.2/msmpisetup.exe + # run: curl -L -O https://github.com/microsoft/Microsoft-MPI/releases/download/v10.1.2/msmpisetup.exe 10.1.1 + run: curl -L -O https://download.microsoft.com/download/a/5/2/a5207ca5-1203-491a-8fb8-906fd68ae623/msmpisetup.exe # 10.1.2 - name: (Windows) Install mpiexec.exe (-force needed to bypass GUI on headless) if: contains(matrix.os,'windows') From 2212c664aed90d97c1534d036a60187b61c3f125 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 4 May 2023 09:14:38 +0200 Subject: [PATCH 178/304] windows Intel CI init --- .github/workflows/meta.yml | 42 ++++++++++++++++++++++---------------- 1 file changed, 24 insertions(+), 18 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 0b1ab30568..3ab7cb5ee4 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -28,18 +28,20 @@ jobs: fail-fast: false matrix: include: - - os: ubuntu-latest + #- os: ubuntu-latest + # mpi: intel + #- os: ubuntu-latest + #mpi: openmpi + #- os: ubuntu-latest + #mpi: mpich + #- os: windows-latest + # mpi: msmpi + - os: windows-latest mpi: intel - - os: ubuntu-latest - mpi: openmpi - - os: ubuntu-latest - mpi: mpich - - os: windows-latest - mpi: msmpi - - os: macos-latest - mpi: openmpi - - os: macos-latest - mpi: mpich + #- os: macos-latest + #mpi: openmpi + #- os: macos-latest + #mpi: mpich steps: - name: Checkout code @@ -55,8 +57,9 @@ jobs: run: | echo "GCC_V=13" >> $GITHUB_ENV - - uses: msys2/setup-msys2@v2 - if: contains(matrix.os,'windows') + - name: (Windows) Install MSYS2 + uses: msys2/setup-msys2@v2 + if: contains(matrix.os,'windows') with: msystem: MINGW64 update: true @@ -68,6 +71,9 @@ jobs: curl gcc-fortran + - name: (Windows) Install OneAPI + if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') + - name: (Ubuntu) Install gfortran if: contains(matrix.os,'ubuntu') && (!contains(matrix.mpi,'intel')) run: | @@ -112,27 +118,27 @@ jobs: run: echo "${{ runner.temp }}/msys64/mingw64/bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append - name: (Windows) download MS-MPI setup (SDK is from MSYS2) - if: contains(matrix.os,'windows') + if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') # run: curl -L -O https://github.com/microsoft/Microsoft-MPI/releases/download/v10.1.2/msmpisetup.exe 10.1.1 run: curl -L -O https://download.microsoft.com/download/a/5/2/a5207ca5-1203-491a-8fb8-906fd68ae623/msmpisetup.exe # 10.1.2 - name: (Windows) Install mpiexec.exe (-force needed to bypass GUI on headless) - if: contains(matrix.os,'windows') + if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') run: .\msmpisetup.exe -unattend -force - name: (Windows) test that mpiexec.exe exists - if: contains(matrix.os,'windows') + if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') # can't use MSMPI_BIN as Actions doesn't update PATH from msmpisetup.exe run: Test-Path "C:\Program Files\Microsoft MPI\Bin\mpiexec.exe" -PathType leaf - name: (Windows) put MSMPI_BIN on PATH (where mpiexec is) - if: contains(matrix.os,'windows') + if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') run: | echo "C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append echo "MSMPI_BIN=C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_ENV -Append - name: (Windows) Install MSYS2 msmpi package - if: contains(matrix.os,'windows') + if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') shell: msys2 {0} run: pacman --noconfirm -S mingw-w64-x86_64-msmpi From 84202de84d085af279ad0bea0c671d3e81362724 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 4 May 2023 09:16:46 +0200 Subject: [PATCH 179/304] Update meta.yml --- .github/workflows/meta.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 3ab7cb5ee4..95f1d18913 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -73,6 +73,7 @@ jobs: - name: (Windows) Install OneAPI if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') + run: echo "HELLO ONEAPI" - name: (Ubuntu) Install gfortran if: contains(matrix.os,'ubuntu') && (!contains(matrix.mpi,'intel')) From 6540d56d8eca52c111a82f6b8f5993ebeb5f4ec1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 4 May 2023 09:20:20 +0200 Subject: [PATCH 180/304] use intel action --- .github/workflows/meta.yml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 95f1d18913..c53979b0bc 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -59,7 +59,7 @@ jobs: - name: (Windows) Install MSYS2 uses: msys2/setup-msys2@v2 - if: contains(matrix.os,'windows') + if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') with: msystem: MINGW64 update: true @@ -73,7 +73,11 @@ jobs: - name: (Windows) Install OneAPI if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') - run: echo "HELLO ONEAPI" + uses: awvwgk/setup-fortran@v1 + id: setup-fortran + with: + compiler: intel + version: '2023.1' - name: (Ubuntu) Install gfortran if: contains(matrix.os,'ubuntu') && (!contains(matrix.mpi,'intel')) From 19e4c02b3f32c9bfb56ef98f9ed9a564d0395b38 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 4 May 2023 11:26:01 +0200 Subject: [PATCH 181/304] Update meta.yml --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index c53979b0bc..3675bab32b 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -73,7 +73,7 @@ jobs: - name: (Windows) Install OneAPI if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') - uses: awvwgk/setup-fortran@v1 + uses: awvwgk/setup-fortran@main id: setup-fortran with: compiler: intel From a4ac1dbf4feb4b1e7471c06fdd2044cdb694baa9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 5 May 2023 01:56:13 -0500 Subject: [PATCH 182/304] Download Intel OneAPI installer --- .github/workflows/meta.yml | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 3675bab32b..5647dc1ef9 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -73,12 +73,11 @@ jobs: - name: (Windows) Install OneAPI if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') - uses: awvwgk/setup-fortran@main - id: setup-fortran - with: - compiler: intel - version: '2023.1' - + shell: pwsh + working-directory: C:\TEMP + run: | + curl.exe --output .\webimage.exe --url https://registrationcenter-download.intel.com/akdlm/irc_nas/19085/w_HPCKit_p_2023.0.0.25931_offline.exe --retry 5 --retry-delay 5 + - name: (Ubuntu) Install gfortran if: contains(matrix.os,'ubuntu') && (!contains(matrix.mpi,'intel')) run: | From ace990ee19fca4a508c528b5fdf8557d265c8266 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 5 May 2023 02:02:18 -0500 Subject: [PATCH 183/304] finish installing, delete temp --- .github/workflows/meta.yml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 5647dc1ef9..7e63a621cf 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -76,7 +76,10 @@ jobs: shell: pwsh working-directory: C:\TEMP run: | - curl.exe --output .\webimage.exe --url https://registrationcenter-download.intel.com/akdlm/irc_nas/19085/w_HPCKit_p_2023.0.0.25931_offline.exe --retry 5 --retry-delay 5 + curl.exe --output webimage.exe --url https://registrationcenter-download.intel.com/akdlm/irc_nas/19085/w_HPCKit_p_2023.0.0.25931_offline.exe --retry 5 --retry-delay 5 + start /b /wait webimage.exe -s -x -f webimage_extracted --log extract.log + del webimage.exe + more extract.log - name: (Ubuntu) Install gfortran if: contains(matrix.os,'ubuntu') && (!contains(matrix.mpi,'intel')) @@ -117,7 +120,7 @@ jobs: printenv >> $GITHUB_ENV - name: (Windows) Put MSYS2_MinGW64 on PATH - if: contains(matrix.os,'windows') + if: contains(matrix.os,'windows') && !contains(matrix.mpi,'intel') # there is not yet an environment variable for this path from msys2/setup-msys2 run: echo "${{ runner.temp }}/msys64/mingw64/bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append From fc12ee9fa56e512f46475667cbaf099643adcf0c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 5 May 2023 02:06:49 -0500 Subject: [PATCH 184/304] Update meta.yml --- .github/workflows/meta.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 7e63a621cf..8ade0ec225 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -77,8 +77,8 @@ jobs: working-directory: C:\TEMP run: | curl.exe --output webimage.exe --url https://registrationcenter-download.intel.com/akdlm/irc_nas/19085/w_HPCKit_p_2023.0.0.25931_offline.exe --retry 5 --retry-delay 5 - start /b /wait webimage.exe -s -x -f webimage_extracted --log extract.log - del webimage.exe + Start-Process -FilePath "webimage.exe" -ArgumentList "-s -x -f webimage_extracted --log extract.log" -Wait + Remove-Item "webimage.exe" -Force more extract.log - name: (Ubuntu) Install gfortran From c75d99094cfdf9ba4d73317acc6d204a6c06240e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 5 May 2023 02:17:31 -0500 Subject: [PATCH 185/304] install --- .github/workflows/meta.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 8ade0ec225..a27f48e3c6 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -80,6 +80,7 @@ jobs: Start-Process -FilePath "webimage.exe" -ArgumentList "-s -x -f webimage_extracted --log extract.log" -Wait Remove-Item "webimage.exe" -Force more extract.log + Start-Process -FilePath "webimage_extracted\bootstrapper.exe" -ArgumentList "-s --action install --eula=accept --components=""intel.oneapi.win.cpp-compiler:intel.oneapi.win.ifort-compiler:intel.oneapi.win.mpi.devel"" -p=NEED_VS2017_INTEGRATION=0 -p=NEED_VS2019_INTEGRATION=0 -p=NEED_VS2022_INTEGRATION=0 --log-dir=." -Wait - name: (Ubuntu) Install gfortran if: contains(matrix.os,'ubuntu') && (!contains(matrix.mpi,'intel')) From fb0ad935f48b96c7cee2834062b20f157ea43eef Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 5 May 2023 03:03:29 -0500 Subject: [PATCH 186/304] add environment variables --- .github/workflows/meta.yml | 52 +++++++++++++++++++++++--------------- 1 file changed, 32 insertions(+), 20 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index a27f48e3c6..e4d5e44d5a 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -71,16 +71,16 @@ jobs: curl gcc-fortran - - name: (Windows) Install OneAPI + - name: (Windows) Retrieve Intel toolchain if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') shell: pwsh working-directory: C:\TEMP run: | curl.exe --output webimage.exe --url https://registrationcenter-download.intel.com/akdlm/irc_nas/19085/w_HPCKit_p_2023.0.0.25931_offline.exe --retry 5 --retry-delay 5 - Start-Process -FilePath "webimage.exe" -ArgumentList "-s -x -f webimage_extracted --log extract.log" -Wait + Start-Process -FilePath "webimage.exe" -ArgumentList "-s -x -f oneAPI --log extract.log" -Wait Remove-Item "webimage.exe" -Force - more extract.log - Start-Process -FilePath "webimage_extracted\bootstrapper.exe" -ArgumentList "-s --action install --eula=accept --components=""intel.oneapi.win.cpp-compiler:intel.oneapi.win.ifort-compiler:intel.oneapi.win.mpi.devel"" -p=NEED_VS2017_INTEGRATION=0 -p=NEED_VS2019_INTEGRATION=0 -p=NEED_VS2022_INTEGRATION=0 --log-dir=." -Wait + Start-Process -FilePath "oneAPI\bootstrapper.exe" -ArgumentList "-s --action install --eula=accept --components=""intel.oneapi.win.cpp-compiler:intel.oneapi.win.ifort-compiler:intel.oneapi.win.mpi.devel"" -p=NEED_VS2017_INTEGRATION=0 -p=NEED_VS2019_INTEGRATION=0 -p=NEED_VS2022_INTEGRATION=0 --log-dir=." -Wait + Remove-Item "oneAPI" -Force -Recurse - name: (Ubuntu) Install gfortran if: contains(matrix.os,'ubuntu') && (!contains(matrix.mpi,'intel')) @@ -139,12 +139,24 @@ jobs: # can't use MSMPI_BIN as Actions doesn't update PATH from msmpisetup.exe run: Test-Path "C:\Program Files\Microsoft MPI\Bin\mpiexec.exe" -PathType leaf + - name: (Windows) test that OneAPI is installed + if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') + run: | + Test-Path -Path "C:\Program Files (x86)\Intel\oneAPI\setvars.bat" -PathType leaf + Test-Path -Path "C:\Program Files (x86)\Intel\oneAPI\compiler\latest\env\vars.bat" -PathType leaf + - name: (Windows) put MSMPI_BIN on PATH (where mpiexec is) if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') run: | echo "C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append echo "MSMPI_BIN=C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_ENV -Append + - name: (Windows) load OneAPI environment variables + if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') + run: | + echo "C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append + echo "MSMPI_BIN=C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_ENV -Append + - name: (Windows) Install MSYS2 msmpi package if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') shell: msys2 {0} @@ -194,6 +206,22 @@ jobs: mv $(which fpm) fpm-bootstrap${{ matrix.exe }} echo "BOOTSTRAP=$PWD/fpm-bootstrap" >> $GITHUB_ENV + - name: Use Intel compiler for the metapackage tests + if: contains(matrix.mpi,'intel') + shell: bash + run: | + echo "FPM_FC=ifort" >> $GITHUB_ENV + echo "FPM_CC=icc" >> $GITHUB_ENV + echo "FPM_CXX=icpc" >> $GITHUB_ENV + + - name: (macOS) Use gcc/g++ instead of Clang for C/C++ + if: contains(matrix.os,'macOS') + shell: bash + run: | + echo "FPM_FC=gfortran-${{ env.GCC_V }}" >> $GITHUB_ENV + echo "FPM_CC=gcc-${{ env.GCC_V }}" >> $GITHUB_ENV + echo "FPM_CXX=g++-${{ env.GCC_V }}" >> $GITHUB_ENV + - name: Build Fortran fpm (bootstrap) shell: bash run: | @@ -268,22 +296,6 @@ jobs: env: EXE: fpm-${{ env.VERSION }}-${{ matrix.os-arch }}${{ matrix.exe }} - - name: (Ubuntu) Use Intel compiler for the metapackage tests - if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') - shell: bash - run: | - echo "FPM_FC=ifort" >> $GITHUB_ENV - echo "FPM_CC=icc" >> $GITHUB_ENV - echo "FPM_CXX=icpc" >> $GITHUB_ENV - - - name: (macOS) Use gcc/g++ instead of Clang for C/C++ - if: contains(matrix.os,'macOS') - shell: bash - run: | - echo "FPM_FC=gfortran-${{ env.GCC_V }}" >> $GITHUB_ENV - echo "FPM_CC=gcc-${{ env.GCC_V }}" >> $GITHUB_ENV - echo "FPM_CXX=g++-${{ env.GCC_V }}" >> $GITHUB_ENV - - name: Run metapackage tests using the release version shell: bash run: | From ebd233113381d59c2421e360d09b229653c5ad33 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 5 May 2023 04:25:41 -0500 Subject: [PATCH 187/304] set Intel environment --- .github/workflows/meta.yml | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index e4d5e44d5a..a110b9102e 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -70,6 +70,10 @@ jobs: unzip curl gcc-fortran + + - name: (Windows) Setup VS Build environment + if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') + uses: seanmiddleditch/gha-setup-vsdevenv@master - name: (Windows) Retrieve Intel toolchain if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') @@ -153,9 +157,10 @@ jobs: - name: (Windows) load OneAPI environment variables if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') + shell: cmd run: | - echo "C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append - echo "MSMPI_BIN=C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_ENV -Append + "C:\Program Files (x86)\Intel\oneAPI\setvars.bat" + "C:\Program Files (x86)\Intel\oneAPI\compiler\latest\env\vars.bat" - name: (Windows) Install MSYS2 msmpi package if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') From dd90f55ed93f9251d037e066b14a31574ab0bfcd Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 6 May 2023 06:43:34 +0200 Subject: [PATCH 188/304] turn off Intel + Windows action for now --- .github/workflows/meta.yml | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index a110b9102e..90adcf516d 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -28,20 +28,20 @@ jobs: fail-fast: false matrix: include: - #- os: ubuntu-latest - # mpi: intel - #- os: ubuntu-latest - #mpi: openmpi - #- os: ubuntu-latest - #mpi: mpich - #- os: windows-latest - # mpi: msmpi - - os: windows-latest + - os: ubuntu-latest mpi: intel - #- os: macos-latest - #mpi: openmpi - #- os: macos-latest - #mpi: mpich + - os: ubuntu-latest + mpi: openmpi + - os: ubuntu-latest + mpi: mpich + - os: windows-latest + mpi: msmpi + # - os: windows-latest + # mpi: intel + - os: macos-latest + mpi: openmpi + - os: macos-latest + mpi: mpich steps: - name: Checkout code From fadc272de0dc493279d7d2a88c164c23d1eb28a7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 6 May 2023 07:04:15 +0200 Subject: [PATCH 189/304] do not run fpm tests with Intel compiler here --- .github/workflows/meta.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 90adcf516d..00ca63be13 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -240,6 +240,7 @@ jobs: ${{ env.BOOTSTRAP }} run -- --help - name: Test Fortran fpm (bootstrap) + if: !contains(matrix.mpi,'intel') shell: bash run: | ${{ env.BOOTSTRAP }} test From 5cbc90a3f9e29444bca6e2da74f1b574a665ef73 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 6 May 2023 11:12:58 +0200 Subject: [PATCH 190/304] Update meta.yml --- .github/workflows/meta.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 00ca63be13..53fcd1c2e1 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -125,7 +125,7 @@ jobs: printenv >> $GITHUB_ENV - name: (Windows) Put MSYS2_MinGW64 on PATH - if: contains(matrix.os,'windows') && !contains(matrix.mpi,'intel') + if: contains(matrix.os,'windows') && (!contains(matrix.mpi,'intel')) # there is not yet an environment variable for this path from msys2/setup-msys2 run: echo "${{ runner.temp }}/msys64/mingw64/bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append @@ -240,7 +240,7 @@ jobs: ${{ env.BOOTSTRAP }} run -- --help - name: Test Fortran fpm (bootstrap) - if: !contains(matrix.mpi,'intel') + if: (!contains(matrix.mpi,'intel')) shell: bash run: | ${{ env.BOOTSTRAP }} test From 76b34ea1f355464375219113b59c03a73fab0f7f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 7 May 2023 10:48:30 +0200 Subject: [PATCH 191/304] metapackage manifests shortened --- example_packages/metapackage_mpi/fpm.toml | 21 +++--------------- example_packages/metapackage_mpi_c/fpm.toml | 17 +++----------- example_packages/metapackage_mpi_cpp/fpm.toml | 22 +++++-------------- example_packages/metapackage_openmp/fpm.toml | 16 +------------- example_packages/metapackage_stdlib/fpm.toml | 13 +---------- 5 files changed, 13 insertions(+), 76 deletions(-) diff --git a/example_packages/metapackage_mpi/fpm.toml b/example_packages/metapackage_mpi/fpm.toml index fcd1b7e2d5..8588e99979 100644 --- a/example_packages/metapackage_mpi/fpm.toml +++ b/example_packages/metapackage_mpi/fpm.toml @@ -1,19 +1,4 @@ name = "test_mpi" -version = "0.1.0" -license = "license" -author = "Federico Perini" -maintainer = "federico.perini@hello.world" -copyright = "Copyright 2023, Federico Perini and the fpm maintainers" - -[fortran] -implicit-external = true -implicit-typing = true - -[build] -auto-executables = true - -[dependencies] -mpi = "*" - -[install] -library = false +dependencies.mpi = "*" +fortran.implicit-external=true +fortran.implicit-typing=true diff --git a/example_packages/metapackage_mpi_c/fpm.toml b/example_packages/metapackage_mpi_c/fpm.toml index feb1c0297a..67f4e99918 100644 --- a/example_packages/metapackage_mpi_c/fpm.toml +++ b/example_packages/metapackage_mpi_c/fpm.toml @@ -1,20 +1,9 @@ name = "test_mpi_c" -version = "0.1.0" -license = "license" -author = "Federico Perini" -maintainer = "federico.perini@hello.world" -copyright = "Copyright 2023, Federico Perini and the fpm maintainers" +dependencies.mpi = "*" +fortran.implicit-typing=true +fortran.implicit-external=true [[executable]] name = "test-mpi-c-main" main = "main.c" -[fortran] -implicit-typing=true -implicit-external=true - -[dependencies] -mpi = "*" - -[install] -library = false diff --git a/example_packages/metapackage_mpi_cpp/fpm.toml b/example_packages/metapackage_mpi_cpp/fpm.toml index 7edb3cbd23..4fef8f710c 100644 --- a/example_packages/metapackage_mpi_cpp/fpm.toml +++ b/example_packages/metapackage_mpi_cpp/fpm.toml @@ -1,20 +1,8 @@ name = "test_mpi_cpp" -version = "0.1.0" -license = "license" -author = "Federico Perini" -maintainer = "federico.perini@hello.world" -copyright = "Copyright 2023, Federico Perini and the fpm maintainers" +dependencies.mpi="*" +fortran.implicit-typing=true +fortran.implicit-external=true [[executable]] -name = "test-mpi-cpp" -main = "main.cpp" - -[fortran] -implicit-typing=true -implicit-external=true - -[dependencies] -mpi = "*" - -[install] -library = false +name="test-mpi-cpp" +main="main.cpp" diff --git a/example_packages/metapackage_openmp/fpm.toml b/example_packages/metapackage_openmp/fpm.toml index 442f12b84f..f22f381100 100644 --- a/example_packages/metapackage_openmp/fpm.toml +++ b/example_packages/metapackage_openmp/fpm.toml @@ -1,17 +1,3 @@ name = "test_openmp" -version = "0.1.0" -license = "license" -author = "Federico Perini" -maintainer = "federico.perini@hello.world" -copyright = "Copyright 2023, Federico Perini and the fpm maintainers" +dependencies.openmp = "*" -[build] -auto-executables = true -auto-tests = true -auto-examples = true - -[dependencies] -openmp = "*" - -[install] -library = false diff --git a/example_packages/metapackage_stdlib/fpm.toml b/example_packages/metapackage_stdlib/fpm.toml index 8932b23b2e..3e4e8efe66 100644 --- a/example_packages/metapackage_stdlib/fpm.toml +++ b/example_packages/metapackage_stdlib/fpm.toml @@ -1,13 +1,2 @@ name = "test_stdlib" -version = "0.1.0" - -[build] -auto-executables = true -auto-tests = true -auto-examples = true - -[dependencies] -stdlib = "*" - -[install] -library = false +dependencies.stdlib = "*" From c350228a60614fa62dad869a55e23f480a0e14a9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 01:39:56 -0500 Subject: [PATCH 192/304] Address reviews --- src/fpm/manifest/build.f90 | 1 - src/fpm/manifest/dependency.f90 | 5 ++--- src/fpm/manifest/meta.f90 | 2 +- test/fpm_test/test_manifest.f90 | 8 ++++---- 4 files changed, 7 insertions(+), 9 deletions(-) diff --git a/src/fpm/manifest/build.f90 b/src/fpm/manifest/build.f90 index fb7fae4c42..8047dd045d 100644 --- a/src/fpm/manifest/build.f90 +++ b/src/fpm/manifest/build.f90 @@ -34,7 +34,6 @@ module fpm_manifest_build logical :: module_naming = .false. type(string_t) :: module_prefix - !> Libraries to link against !> Libraries to link against type(string_t), allocatable :: link(:) diff --git a/src/fpm/manifest/dependency.f90 b/src/fpm/manifest/dependency.f90 index 9612f49e37..b770721a21 100644 --- a/src/fpm/manifest/dependency.f90 +++ b/src/fpm/manifest/dependency.f90 @@ -230,7 +230,7 @@ subroutine new_dependencies(deps, table, root, meta, error) ! An empty table is okay if (size(list) < 1) return - !> If requesting metapackages, do not stop on meta keywords + !> Count non-metapackage dependencies, and parse metapackage config if (present(meta)) then ndep = 0 do idep = 1, size(list) @@ -241,16 +241,15 @@ subroutine new_dependencies(deps, table, root, meta, error) !> Return metapackages config from this node call new_meta_config(meta, table, error) if (allocated(error)) return - else ndep = size(list) end if + ! Generate non-metapackage dependencies allocate(deps(ndep)) ndep = 0 do idep = 1, size(list) - ! Skip meta packages if (present(meta) .and. is_meta_package(list(idep)%key)) cycle ndep = ndep+1 diff --git a/src/fpm/manifest/meta.f90 b/src/fpm/manifest/meta.f90 index 9016932b7c..5cfb48c342 100644 --- a/src/fpm/manifest/meta.f90 +++ b/src/fpm/manifest/meta.f90 @@ -62,7 +62,7 @@ elemental subroutine request_destroy(self) end subroutine request_destroy - !> Parse version string of a metapackage reques + !> Parse version string of a metapackage request subroutine request_parse(self, version_request, error) ! Instance of this metapackage diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index 14f39991f7..4c147e945d 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -1367,7 +1367,7 @@ 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_pependency type(package_config_t) :: package, dependency @@ -1413,10 +1413,10 @@ subroutine test_macro_parsing_dependency(error) pkg_ver = package%version%s() dep_ver = dependency%version%s() - macrosPackage = get_macros(id, package%preprocess(1)%macros, pkg_ver) - macrosDependency = get_macros(id, dependency%preprocess(1)%macros, dep_ver) + macros_package = get_macros(id, package%preprocess(1)%macros, pkg_ver) + macros_pependency = get_macros(id, dependency%preprocess(1)%macros, dep_ver) - if (macrosPackage == macrosDependency) then + if (macros_package == macros_pependency) then call test_failed(error, "Macros of package and dependency should not be equal") end if From 0b4ad660b7d8740abe5215ca3a3c21f9e88dd3e8 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 01:48:47 -0500 Subject: [PATCH 193/304] merging fix --- src/fpm/manifest/package.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/manifest/package.f90 b/src/fpm/manifest/package.f90 index d5b5e641fa..6c8fed4bb0 100644 --- a/src/fpm/manifest/package.f90 +++ b/src/fpm/manifest/package.f90 @@ -43,7 +43,7 @@ module fpm_manifest_package use fpm_manifest_library, only : library_config_t, new_library use fpm_manifest_install, only: install_config_t, new_install_config use fpm_manifest_test, only : test_config_t, new_test - use fpm_mainfest_preprocess, only : preprocess_config_t, new_preprocessors + use fpm_manifest_preprocess, only : preprocess_config_t, new_preprocessors use fpm_manifest_metapackages, only: metapackage_config_t, new_meta_config use fpm_filesystem, only : exists, getline, join_path use fpm_error, only : error_t, fatal_error, syntax_error, bad_name_error From 2ebb568e2aa1e3fc8a033dd7eeb0b894737cc572 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 01:57:01 -0500 Subject: [PATCH 194/304] (macOS) only install gfortran if not already available --- .github/workflows/meta.yml | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 53fcd1c2e1..2771be9d99 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -34,7 +34,7 @@ jobs: mpi: openmpi - os: ubuntu-latest mpi: mpich - - os: windows-latest + - os: windows-latest mpi: msmpi # - os: windows-latest # mpi: intel @@ -51,7 +51,7 @@ jobs: if: contains(matrix.os,'ubuntu') run: | echo "GCC_V=10" >> $GITHUB_ENV - + - name: (macOS) setup gcc version if: contains(matrix.os,'macos') run: | @@ -59,7 +59,7 @@ jobs: - name: (Windows) Install MSYS2 uses: msys2/setup-msys2@v2 - if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') + if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') with: msystem: MINGW64 update: true @@ -70,22 +70,22 @@ jobs: unzip curl gcc-fortran - - - name: (Windows) Setup VS Build environment + + - name: (Windows) Setup VS Build environment if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') - uses: seanmiddleditch/gha-setup-vsdevenv@master + uses: seanmiddleditch/gha-setup-vsdevenv@master - name: (Windows) Retrieve Intel toolchain if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') shell: pwsh working-directory: C:\TEMP run: | - curl.exe --output webimage.exe --url https://registrationcenter-download.intel.com/akdlm/irc_nas/19085/w_HPCKit_p_2023.0.0.25931_offline.exe --retry 5 --retry-delay 5 + curl.exe --output webimage.exe --url https://registrationcenter-download.intel.com/akdlm/irc_nas/19085/w_HPCKit_p_2023.0.0.25931_offline.exe --retry 5 --retry-delay 5 Start-Process -FilePath "webimage.exe" -ArgumentList "-s -x -f oneAPI --log extract.log" -Wait Remove-Item "webimage.exe" -Force Start-Process -FilePath "oneAPI\bootstrapper.exe" -ArgumentList "-s --action install --eula=accept --components=""intel.oneapi.win.cpp-compiler:intel.oneapi.win.ifort-compiler:intel.oneapi.win.mpi.devel"" -p=NEED_VS2017_INTEGRATION=0 -p=NEED_VS2019_INTEGRATION=0 -p=NEED_VS2022_INTEGRATION=0 --log-dir=." -Wait Remove-Item "oneAPI" -Force -Recurse - + - name: (Ubuntu) Install gfortran if: contains(matrix.os,'ubuntu') && (!contains(matrix.mpi,'intel')) run: | @@ -135,7 +135,7 @@ jobs: run: curl -L -O https://download.microsoft.com/download/a/5/2/a5207ca5-1203-491a-8fb8-906fd68ae623/msmpisetup.exe # 10.1.2 - name: (Windows) Install mpiexec.exe (-force needed to bypass GUI on headless) - if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') + if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') run: .\msmpisetup.exe -unattend -force - name: (Windows) test that mpiexec.exe exists @@ -145,7 +145,7 @@ jobs: - name: (Windows) test that OneAPI is installed if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') - run: | + run: | Test-Path -Path "C:\Program Files (x86)\Intel\oneAPI\setvars.bat" -PathType leaf Test-Path -Path "C:\Program Files (x86)\Intel\oneAPI\compiler\latest\env\vars.bat" -PathType leaf @@ -153,14 +153,14 @@ jobs: if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') run: | echo "C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append - echo "MSMPI_BIN=C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_ENV -Append + echo "MSMPI_BIN=C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_ENV -Append - - name: (Windows) load OneAPI environment variables + - name: (Windows) load OneAPI environment variables if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') shell: cmd run: | "C:\Program Files (x86)\Intel\oneAPI\setvars.bat" - "C:\Program Files (x86)\Intel\oneAPI\compiler\latest\env\vars.bat" + "C:\Program Files (x86)\Intel\oneAPI\compiler\latest\env\vars.bat" - name: (Windows) Install MSYS2 msmpi package if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') @@ -175,10 +175,11 @@ jobs: - name: (macOS) Install Homebrew gfortran if: contains(matrix.os, 'macos') run: | - brew install gcc@${{ env.GCC_V }} + # Only install gcc if not already available + which gfortran-${{ env.GCC_V }} || brew install gcc@${{ env.GCC_V }} which gfortran-${{ env.GCC_V }} which gfortran - # Backport gfortran shared libraries to version 10 folder. This is necessary because all macOS releases of fpm + # Backport gfortran shared libraries to version 10 folder. This is necessary because all macOS releases of fpm # have these paths hardcoded in the executable (no PIC?). Current bootstrap version 0.8.0 has gcc-10 mkdir /usr/local/opt/gcc@10 mkdir /usr/local/opt/gcc@10/lib @@ -220,7 +221,7 @@ jobs: echo "FPM_CXX=icpc" >> $GITHUB_ENV - name: (macOS) Use gcc/g++ instead of Clang for C/C++ - if: contains(matrix.os,'macOS') + if: contains(matrix.os,'macOS') shell: bash run: | echo "FPM_FC=gfortran-${{ env.GCC_V }}" >> $GITHUB_ENV From 69f06508848c2b82c1617cd368646f07a4bc98a6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 02:06:23 -0500 Subject: [PATCH 195/304] use libgcc_s.1.1.dylib if libgcc_s.1.dylib not available (gcc>=13) --- .github/workflows/meta.yml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 2771be9d99..8af7403f88 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -188,7 +188,9 @@ jobs: mkdir /usr/local/lib/gcc/10 ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libquadmath.0.dylib /usr/local/opt/gcc@10/lib/gcc/10/libquadmath.0.dylib ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libgfortran.5.dylib /usr/local/opt/gcc@10/lib/gcc/10/libgfortran.5.dylib - ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib + # Newer gcc versions use libgcc_s.1.1.dylib + ls /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib && ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib + ls /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.1.dylib && ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib - name: (macOS) Install homebrew MPICH if: contains(matrix.mpi,'mpich') && contains(matrix.os,'macos') From f3b76a4b2b45ba7ab55a8a18385722be17977cf1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 02:11:03 -0500 Subject: [PATCH 196/304] Update meta.yml --- .github/workflows/meta.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 8af7403f88..6b16724ba5 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -189,8 +189,7 @@ jobs: ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libquadmath.0.dylib /usr/local/opt/gcc@10/lib/gcc/10/libquadmath.0.dylib ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libgfortran.5.dylib /usr/local/opt/gcc@10/lib/gcc/10/libgfortran.5.dylib # Newer gcc versions use libgcc_s.1.1.dylib - ls /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib && ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib - ls /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.1.dylib && ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib + ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib || ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib - name: (macOS) Install homebrew MPICH if: contains(matrix.mpi,'mpich') && contains(matrix.os,'macos') From 2f497aae9170a1aa7e61ce486a548fc21b57e9fd Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 02:17:22 -0500 Subject: [PATCH 197/304] macOS test --- .github/workflows/meta.yml | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 6b16724ba5..70520ff637 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -28,20 +28,20 @@ jobs: fail-fast: false matrix: include: - - os: ubuntu-latest - mpi: intel - - os: ubuntu-latest - mpi: openmpi - - os: ubuntu-latest - mpi: mpich - - os: windows-latest - mpi: msmpi +# - os: ubuntu-latest +# mpi: intel +# - os: ubuntu-latest +# mpi: openmpi +# - os: ubuntu-latest +# mpi: mpich +# - os: windows-latest +# mpi: msmpi # - os: windows-latest # mpi: intel - os: macos-latest mpi: openmpi - - os: macos-latest - mpi: mpich +# - os: macos-latest +# mpi: mpich steps: - name: Checkout code @@ -186,10 +186,10 @@ jobs: mkdir /usr/local/opt/gcc@10/lib/gcc mkdir /usr/local/opt/gcc@10/lib/gcc/10 mkdir /usr/local/lib/gcc/10 - ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libquadmath.0.dylib /usr/local/opt/gcc@10/lib/gcc/10/libquadmath.0.dylib - ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libgfortran.5.dylib /usr/local/opt/gcc@10/lib/gcc/10/libgfortran.5.dylib - # Newer gcc versions use libgcc_s.1.1.dylib - ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib || ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib +# ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libquadmath.0.dylib /usr/local/opt/gcc@10/lib/gcc/10/libquadmath.0.dylib +# ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libgfortran.5.dylib /usr/local/opt/gcc@10/lib/gcc/10/libgfortran.5.dylib +# # Newer gcc versions use libgcc_s.1.1.dylib +# ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib || ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib - name: (macOS) Install homebrew MPICH if: contains(matrix.mpi,'mpich') && contains(matrix.os,'macos') From 48551925451317425ca8aa21f0b40fc0fa440635 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 02:19:01 -0500 Subject: [PATCH 198/304] Update meta.yml --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 70520ff637..afd151853d 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -178,7 +178,7 @@ jobs: # Only install gcc if not already available which gfortran-${{ env.GCC_V }} || brew install gcc@${{ env.GCC_V }} which gfortran-${{ env.GCC_V }} - which gfortran +# which gfortran # Backport gfortran shared libraries to version 10 folder. This is necessary because all macOS releases of fpm # have these paths hardcoded in the executable (no PIC?). Current bootstrap version 0.8.0 has gcc-10 mkdir /usr/local/opt/gcc@10 From 5d664a411229c0832eb9e512016a57fbc678e926 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 02:21:14 -0500 Subject: [PATCH 199/304] Update meta.yml --- .github/workflows/meta.yml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index afd151853d..c6f057ec0b 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -178,7 +178,7 @@ jobs: # Only install gcc if not already available which gfortran-${{ env.GCC_V }} || brew install gcc@${{ env.GCC_V }} which gfortran-${{ env.GCC_V }} -# which gfortran + # which gfortran # Backport gfortran shared libraries to version 10 folder. This is necessary because all macOS releases of fpm # have these paths hardcoded in the executable (no PIC?). Current bootstrap version 0.8.0 has gcc-10 mkdir /usr/local/opt/gcc@10 @@ -186,10 +186,10 @@ jobs: mkdir /usr/local/opt/gcc@10/lib/gcc mkdir /usr/local/opt/gcc@10/lib/gcc/10 mkdir /usr/local/lib/gcc/10 -# ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libquadmath.0.dylib /usr/local/opt/gcc@10/lib/gcc/10/libquadmath.0.dylib -# ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libgfortran.5.dylib /usr/local/opt/gcc@10/lib/gcc/10/libgfortran.5.dylib -# # Newer gcc versions use libgcc_s.1.1.dylib -# ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib || ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib + #ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libquadmath.0.dylib /usr/local/opt/gcc@10/lib/gcc/10/libquadmath.0.dylib + #ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libgfortran.5.dylib /usr/local/opt/gcc@10/lib/gcc/10/libgfortran.5.dylib + ## Newer gcc versions use libgcc_s.1.1.dylib + #ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib || ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib - name: (macOS) Install homebrew MPICH if: contains(matrix.mpi,'mpich') && contains(matrix.os,'macos') From 2f1e3a9a8fd454b2ae6c09112223f835c9dc70c1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 02:23:49 -0500 Subject: [PATCH 200/304] fix link to gfortran --- .github/workflows/meta.yml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index c6f057ec0b..139aedf7fc 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -178,7 +178,7 @@ jobs: # Only install gcc if not already available which gfortran-${{ env.GCC_V }} || brew install gcc@${{ env.GCC_V }} which gfortran-${{ env.GCC_V }} - # which gfortran + which gfortran || ln -s /usr/local/bin/gfortran-${{ env.GCC_V }} /usr/local/bin/gfortran # Backport gfortran shared libraries to version 10 folder. This is necessary because all macOS releases of fpm # have these paths hardcoded in the executable (no PIC?). Current bootstrap version 0.8.0 has gcc-10 mkdir /usr/local/opt/gcc@10 @@ -186,10 +186,10 @@ jobs: mkdir /usr/local/opt/gcc@10/lib/gcc mkdir /usr/local/opt/gcc@10/lib/gcc/10 mkdir /usr/local/lib/gcc/10 - #ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libquadmath.0.dylib /usr/local/opt/gcc@10/lib/gcc/10/libquadmath.0.dylib - #ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libgfortran.5.dylib /usr/local/opt/gcc@10/lib/gcc/10/libgfortran.5.dylib - ## Newer gcc versions use libgcc_s.1.1.dylib - #ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib || ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib + ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libquadmath.0.dylib /usr/local/opt/gcc@10/lib/gcc/10/libquadmath.0.dylib + ln -fs /usr/local/opt/gcc@${{ env.GCC_V }}/lib/gcc/${{ env.GCC_V }}/libgfortran.5.dylib /usr/local/opt/gcc@10/lib/gcc/10/libgfortran.5.dylib + # Newer gcc versions use libgcc_s.1.1.dylib + ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib || ln -fs /usr/local/lib/gcc/${{ env.GCC_V }}/libgcc_s.1.1.dylib /usr/local/lib/gcc/10/libgcc_s.1.dylib - name: (macOS) Install homebrew MPICH if: contains(matrix.mpi,'mpich') && contains(matrix.os,'macos') From 02adf0f20a4429f562f53c3d3cae0e1eac63315d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 07:57:10 -0500 Subject: [PATCH 201/304] restore all environments --- .github/workflows/meta.yml | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 139aedf7fc..b32bf0c90c 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -28,20 +28,20 @@ jobs: fail-fast: false matrix: include: -# - os: ubuntu-latest -# mpi: intel -# - os: ubuntu-latest -# mpi: openmpi -# - os: ubuntu-latest -# mpi: mpich -# - os: windows-latest -# mpi: msmpi + - os: ubuntu-latest + mpi: intel + - os: ubuntu-latest + mpi: openmpi + - os: ubuntu-latest + mpi: mpich + - os: windows-latest + mpi: msmpi # - os: windows-latest # mpi: intel - os: macos-latest mpi: openmpi -# - os: macos-latest -# mpi: mpich + - os: macos-latest + mpi: mpich steps: - name: Checkout code From ce8334ab9520d724cb610bbed11a549e2b829697 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 08:13:19 -0500 Subject: [PATCH 202/304] test windows only --- .github/workflows/meta.yml | 21 +++++++++++---------- src/fpm_meta.f90 | 8 ++++++-- 2 files changed, 17 insertions(+), 12 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index b32bf0c90c..0266ef2b78 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -28,20 +28,21 @@ jobs: fail-fast: false matrix: include: - - os: ubuntu-latest - mpi: intel - - os: ubuntu-latest - mpi: openmpi - - os: ubuntu-latest - mpi: mpich + # - os: ubuntu-latest + # mpi: intel + # - os: ubuntu-latest + # mpi: openmpi + # - os: ubuntu-latest + # mpi: mpich - os: windows-latest mpi: msmpi # - os: windows-latest # mpi: intel - - os: macos-latest - mpi: openmpi - - os: macos-latest - mpi: mpich + # - os: macos-latest + # mpi: openmpi + # - os: macos-latest + # mpi: mpich + steps: - name: Checkout code diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 0faa916d19..6764bb826b 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -577,17 +577,21 @@ logical function msmpi_init(this,compiler,error) result(found) ! In some environments, variable %MSMPI_BIN% is missing (i.e. in GitHub Action images). ! Do a second attempt: search for mpiexec.exe if (len_trim(bindir)<=0 .or. .not.exists(bindir)) then + print *, '+ MSMPI_BIN path does not exist, searching mpiexec.exe....' call find_command_location('mpiexec.exe',bindir,verbose=verbose,error=error) endif ! Do a third attempt: search for mpiexec.exe in the default location if (len_trim(bindir)<=0 .or. .not.exists(bindir) .or. allocated(error)) then + print *, '+ MSMPI_BIN path does not exist, searching C:\Program Files\Microsoft MPI\Bin\mpiexec.exe....' windir = get_dos_path('C:\Program Files\Microsoft MPI\Bin\mpiexec.exe',error) print *, 'windir=',windir - if (.not.allocated(error)) & - call find_command_location(windir,bindir,verbose=verbose,error=error) + if (.not.allocated(error)) then + print *, '+ searching location of ',windir + call find_command_location(windir,bindir,verbose=verbose,error=error) + endif endif From 1db25494af09d0ba21cfc683363f73ff4cb5e2e5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 08:20:05 -0500 Subject: [PATCH 203/304] increase line buffer length to Windows max --- src/fpm_filesystem.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index d2ffb61f0c..7367dcbbd0 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -16,7 +16,7 @@ module fpm_filesystem 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, get_dos_path - integer, parameter :: LINE_BUFFER_LEN = 1000 + integer, parameter :: LINE_BUFFER_LEN = 32768 #ifndef FPM_BOOTSTRAP interface From 9977834a3e4c631a47e50a18fa2861bf68922af0 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 08:31:58 -0500 Subject: [PATCH 204/304] restore all environments --- .github/workflows/meta.yml | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 0266ef2b78..93075fd812 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -28,20 +28,18 @@ jobs: fail-fast: false matrix: include: - # - os: ubuntu-latest - # mpi: intel - # - os: ubuntu-latest - # mpi: openmpi - # - os: ubuntu-latest - # mpi: mpich + - os: ubuntu-latest + mpi: intel + - os: ubuntu-latest + mpi: openmpi + - os: ubuntu-latest + mpi: mpich - os: windows-latest mpi: msmpi - # - os: windows-latest - # mpi: intel - # - os: macos-latest - # mpi: openmpi - # - os: macos-latest - # mpi: mpich + - os: macos-latest + mpi: openmpi + - os: macos-latest + mpi: mpich steps: From 6ea99998e0ddf8c92212a839607cbbfc00ceba9a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 17:17:33 +0200 Subject: [PATCH 205/304] 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 79373b97423c03346fce9fcf61fbb16121ebac70 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 18:43:22 +0200 Subject: [PATCH 206/304] MS_MPI: make DOS path --- src/fpm_meta.f90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 6764bb826b..cfa3e8ebb5 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -572,11 +572,16 @@ logical function msmpi_init(this,compiler,error) result(found) ! Check that the runtime is installed bindir = get_env('MSMPI_BIN') + ! Always use DOS paths with no spaces + if (len_trim(bindir)>0) then + bindir = get_dos_path('C:\Program Files\Microsoft MPI\Bin\mpiexec.exe',error) + endif + print *, 'bindir=',bindir ! In some environments, variable %MSMPI_BIN% is missing (i.e. in GitHub Action images). ! Do a second attempt: search for mpiexec.exe - if (len_trim(bindir)<=0 .or. .not.exists(bindir)) then + if (len_trim(bindir)<=0 .or. .not.exists(bindir) .or. allocated(error)) then print *, '+ MSMPI_BIN path does not exist, searching mpiexec.exe....' call find_command_location('mpiexec.exe',bindir,verbose=verbose,error=error) endif From 7dca2e86eb9666bf3956659a856563df578d153f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 19:06:41 +0200 Subject: [PATCH 207/304] add many checks --- src/fpm_meta.f90 | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index cfa3e8ebb5..6e5e87c8fb 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -736,12 +736,18 @@ subroutine find_command_location(command,path,echo,verbose,error) return end if + print *, '+ get temp filename...' + tmp_file = get_temp_filename() + print *, '+ get temp filename... '//tmp_file + ! On Windows, we try both commands because we may be on WSL do try=merge(1,2,get_os_type()==OS_WINDOWS),2 search_command = search(try)//command + print *, '+ attempt ',try,': ',search_command call run(search_command, echo=echo, exitstat=stat, verbose=verbose, redirect=tmp_file) + print *, 'after run, stat=',stat if (stat==0) exit end do if (stat/=0) then @@ -755,6 +761,7 @@ subroutine find_command_location(command,path,echo,verbose,error) if (stat == 0)then do call getline(iunit, line, stat) + print *, 'get line, stat=',stat if (stat /= 0) exit if (len(screen_output)>0) then screen_output = screen_output//new_line('a')//line @@ -771,6 +778,8 @@ subroutine find_command_location(command,path,echo,verbose,error) ! Only use the first instance length = index(screen_output,new_line('a')) + + print *, '+ get line length: ',length multiline: if (length>1) then fullpath = screen_output(1:length-1) else @@ -783,6 +792,7 @@ subroutine find_command_location(command,path,echo,verbose,error) ! Extract path only length = index(fullpath,command,BACK=.true.) + print *, 'extract fullpath, length=',length if (length<=0) then call fatal_error(error,'full path to command ('//command//') does not include command name') return @@ -795,9 +805,13 @@ subroutine find_command_location(command,path,echo,verbose,error) if (allocated(error)) return ! On Windows, be sure to return a path with no spaces - if (get_os_type()==OS_WINDOWS) path = get_dos_path(path,error) + if (get_os_type()==OS_WINDOWS) then + print *, 'get dos path' + path = get_dos_path(path,error) + print *, 'dos path = ',path + end if - if (.not.is_dir(path)) then + if (allocated(error) .or. .not.is_dir(path)) then call fatal_error(error,'full path ('//path//') to command ('//command//') is not a directory') return end if From 0fcca0ebc4fc1b53834d45d47c456d28e5797e32 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 20:05:27 +0200 Subject: [PATCH 208/304] echo runner folder --- src/fpm_meta.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 6e5e87c8fb..af4ea39fd7 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -836,6 +836,7 @@ subroutine get_mpi_runner(command,verbose,error) ! Success! success = len_trim(command%s)>0 if (success) then + if (verbose) print *, '+ runner folder found: '//command%s command%s = join_path(command%s,trim(try(itri))) return endif From 1a948beeabc5852e8ec56d11f9c702033ddafc57 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 20:26:19 +0200 Subject: [PATCH 209/304] refactor windows search --- src/fpm_meta.f90 | 31 +++++++++++++------------------ 1 file changed, 13 insertions(+), 18 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index af4ea39fd7..8fbc069217 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -570,31 +570,26 @@ logical function msmpi_init(this,compiler,error) result(found) end if ! Check that the runtime is installed - bindir = get_env('MSMPI_BIN') + bindir = "" + call get_absolute_path(get_env('MSMPI_BIN'),bindir,error) - ! Always use DOS paths with no spaces - if (len_trim(bindir)>0) then - bindir = get_dos_path('C:\Program Files\Microsoft MPI\Bin\mpiexec.exe',error) - endif - - print *, 'bindir=',bindir + print *, '+ bindir=',bindir + print *, '+ windir=',windir ! In some environments, variable %MSMPI_BIN% is missing (i.e. in GitHub Action images). - ! Do a second attempt: search for mpiexec.exe - if (len_trim(bindir)<=0 .or. .not.exists(bindir) .or. allocated(error)) then - print *, '+ MSMPI_BIN path does not exist, searching mpiexec.exe....' - call find_command_location('mpiexec.exe',bindir,verbose=verbose,error=error) + ! Do a second attempt: search for the default location + if (len_trim(bindir)<=0 .or. allocated(error)) then + print *, '+ MSMPI_BIN path does not exist, searching C:\Program Files\Microsoft MPI\Bin\....' + call get_absolute_path('C:\Program Files\Microsoft MPI\Bin\mpiexec.exe',bindir,error) endif - ! Do a third attempt: search for mpiexec.exe in the default location - if (len_trim(bindir)<=0 .or. .not.exists(bindir) .or. allocated(error)) then - print *, '+ MSMPI_BIN path does not exist, searching C:\Program Files\Microsoft MPI\Bin\mpiexec.exe....' - windir = get_dos_path('C:\Program Files\Microsoft MPI\Bin\mpiexec.exe',error) + ! Do a third attempt: search for mpiexec.exe in PATH location + if (len_trim(bindir)<=0 .or. allocated(error)) then - print *, 'windir=',windir + call get_mpi_runner(windir,verbose,error) if (.not.allocated(error)) then - print *, '+ searching location of ',windir + print *, '+ searching location of mpi runner, ',windir call find_command_location(windir,bindir,verbose=verbose,error=error) endif @@ -821,7 +816,7 @@ end subroutine find_command_location !> Get MPI runner in $PATH subroutine get_mpi_runner(command,verbose,error) type(string_t), intent(out) :: command - logical, optional, intent(in) :: verbose + logical, intent(in) :: verbose type(error_t), allocatable, intent(out) :: error character(*), parameter :: try(*) = ['mpiexec','mpirun '] From bad1556ecada542fe42bbd70aef12089f1569daf Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 20:27:05 +0200 Subject: [PATCH 210/304] Update fpm_meta.f90 --- src/fpm_meta.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 8fbc069217..a414ceb7ae 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -539,7 +539,7 @@ logical function msmpi_init(this,compiler,error) result(found) character(len=:), allocatable :: incdir,windir,libdir,bindir,post,reall,msysdir type(version_t) :: ver,ver10 - type(string_t) :: cpath,msys_path + type(string_t) :: cpath,msys_path,runner_path logical :: msys2 !> Default: not found @@ -586,11 +586,11 @@ logical function msmpi_init(this,compiler,error) result(found) ! Do a third attempt: search for mpiexec.exe in PATH location if (len_trim(bindir)<=0 .or. allocated(error)) then - call get_mpi_runner(windir,verbose,error) + call get_mpi_runner(runner_path,verbose,error) if (.not.allocated(error)) then print *, '+ searching location of mpi runner, ',windir - call find_command_location(windir,bindir,verbose=verbose,error=error) + call find_command_location(runner_path%s,bindir,verbose=verbose,error=error) endif endif From f8e13ee4005182ff5824dbcdfadaaa5604f755ce Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 11 May 2023 20:36:02 +0200 Subject: [PATCH 211/304] cleanup debugging prints --- src/fpm_meta.f90 | 28 +++++++--------------------- 1 file changed, 7 insertions(+), 21 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index a414ceb7ae..438ceee5f0 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -94,7 +94,7 @@ module fpm_meta public :: MPI_TYPE_NAME !> Debugging information -logical, parameter, private :: verbose = .true. +logical, parameter, private :: verbose = .false. integer, parameter, private :: LANG_FORTRAN = 1 integer, parameter, private :: LANG_C = 2 @@ -572,24 +572,23 @@ logical function msmpi_init(this,compiler,error) result(found) ! Check that the runtime is installed bindir = "" call get_absolute_path(get_env('MSMPI_BIN'),bindir,error) - - print *, '+ bindir=',bindir - print *, '+ windir=',windir + if (verbose) print *, '+ %MSMPI_BIN%=',bindir ! In some environments, variable %MSMPI_BIN% is missing (i.e. in GitHub Action images). ! Do a second attempt: search for the default location if (len_trim(bindir)<=0 .or. allocated(error)) then - print *, '+ MSMPI_BIN path does not exist, searching C:\Program Files\Microsoft MPI\Bin\....' + if (verbose) print *, '+ %MSMPI_BIN% empty, searching C:\Program Files\Microsoft MPI\Bin\ ...' call get_absolute_path('C:\Program Files\Microsoft MPI\Bin\mpiexec.exe',bindir,error) endif ! Do a third attempt: search for mpiexec.exe in PATH location if (len_trim(bindir)<=0 .or. allocated(error)) then + if (verbose) print *, '+ C:\Program Files\Microsoft MPI\Bin\ not found. searching %PATH%...' call get_mpi_runner(runner_path,verbose,error) if (.not.allocated(error)) then - print *, '+ searching location of mpi runner, ',windir + if (verbose) print *, '+ mpiexec found: ',runner_path%s call find_command_location(runner_path%s,bindir,verbose=verbose,error=error) endif @@ -731,18 +730,12 @@ subroutine find_command_location(command,path,echo,verbose,error) return end if - print *, '+ get temp filename...' - tmp_file = get_temp_filename() - print *, '+ get temp filename... '//tmp_file - ! On Windows, we try both commands because we may be on WSL do try=merge(1,2,get_os_type()==OS_WINDOWS),2 search_command = search(try)//command - print *, '+ attempt ',try,': ',search_command call run(search_command, echo=echo, exitstat=stat, verbose=verbose, redirect=tmp_file) - print *, 'after run, stat=',stat if (stat==0) exit end do if (stat/=0) then @@ -756,7 +749,6 @@ subroutine find_command_location(command,path,echo,verbose,error) if (stat == 0)then do call getline(iunit, line, stat) - print *, 'get line, stat=',stat if (stat /= 0) exit if (len(screen_output)>0) then screen_output = screen_output//new_line('a')//line @@ -774,7 +766,6 @@ subroutine find_command_location(command,path,echo,verbose,error) ! Only use the first instance length = index(screen_output,new_line('a')) - print *, '+ get line length: ',length multiline: if (length>1) then fullpath = screen_output(1:length-1) else @@ -787,7 +778,6 @@ subroutine find_command_location(command,path,echo,verbose,error) ! Extract path only length = index(fullpath,command,BACK=.true.) - print *, 'extract fullpath, length=',length if (length<=0) then call fatal_error(error,'full path to command ('//command//') does not include command name') return @@ -800,11 +790,7 @@ subroutine find_command_location(command,path,echo,verbose,error) if (allocated(error)) return ! On Windows, be sure to return a path with no spaces - if (get_os_type()==OS_WINDOWS) then - print *, 'get dos path' - path = get_dos_path(path,error) - print *, 'dos path = ',path - end if + if (get_os_type()==OS_WINDOWS) path = get_dos_path(path,error) if (allocated(error) .or. .not.is_dir(path)) then call fatal_error(error,'full path ('//path//') to command ('//command//') is not a directory') @@ -1195,7 +1181,7 @@ subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_outp ! Empty command if (len_trim(wrapper)<=0) then - if (verbose) print *, '+ ' + if (echo_local) print *, '+ ' if (present(exitcode)) exitcode = 0 if (present(cmd_success)) cmd_success = .true. if (present(screen_output)) screen_output = string_t("") From 5a1656440089b1a7510517bb7807245707240665 Mon Sep 17 00:00:00 2001 From: gnikit Date: Sun, 14 May 2023 22:13:16 +0100 Subject: [PATCH 212/304] 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 213/304] 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 214/304] 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 215/304] 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 216/304] 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 From 69d26bf55276433d11a7bc92fc16afd2d4f78f40 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 25 May 2023 10:17:37 +0200 Subject: [PATCH 217/304] fortran-lang `minpack` --- ci/meta_tests.sh | 5 +++ .../metapackage_minpack/app/main.f90 | 7 ++++ example_packages/metapackage_minpack/fpm.toml | 2 + .../src/metapackage_minpack.f90 | 14 +++++++ src/fpm/manifest/meta.f90 | 10 ++++- src/fpm_meta.f90 | 40 +++++++++++++++++-- 6 files changed, 72 insertions(+), 6 deletions(-) create mode 100644 example_packages/metapackage_minpack/app/main.f90 create mode 100644 example_packages/metapackage_minpack/fpm.toml create mode 100644 example_packages/metapackage_minpack/src/metapackage_minpack.f90 diff --git a/ci/meta_tests.sh b/ci/meta_tests.sh index 54c70ce381..c2911d2737 100755 --- a/ci/meta_tests.sh +++ b/ci/meta_tests.sh @@ -27,6 +27,11 @@ pushd metapackage_stdlib "$fpm" run --verbose popd +pushd metapackage_minpack +"$fpm" build --verbose +"$fpm" run --verbose +popd + pushd metapackage_mpi "$fpm" build --verbose "$fpm" run --verbose diff --git a/example_packages/metapackage_minpack/app/main.f90 b/example_packages/metapackage_minpack/app/main.f90 new file mode 100644 index 0000000000..64008e4102 --- /dev/null +++ b/example_packages/metapackage_minpack/app/main.f90 @@ -0,0 +1,7 @@ +program main + use metapackage_minpack, only: simple_test + implicit none + logical :: success + call simple_test(success) + stop merge(0,1,success) +end program main diff --git a/example_packages/metapackage_minpack/fpm.toml b/example_packages/metapackage_minpack/fpm.toml new file mode 100644 index 0000000000..f178da2a48 --- /dev/null +++ b/example_packages/metapackage_minpack/fpm.toml @@ -0,0 +1,2 @@ +name = "metapackage_minpack" +dependencies.minpack="*" diff --git a/example_packages/metapackage_minpack/src/metapackage_minpack.f90 b/example_packages/metapackage_minpack/src/metapackage_minpack.f90 new file mode 100644 index 0000000000..d09d778409 --- /dev/null +++ b/example_packages/metapackage_minpack/src/metapackage_minpack.f90 @@ -0,0 +1,14 @@ +module metapackage_minpack + use minpack_module, only: wp + use iso_fortran_env, only: real64 + implicit none + private + + public :: simple_test +contains + subroutine simple_test(success) + logical, intent(out) :: success + ! Success! can read minpack module + success = wp == real64 + end subroutine simple_test +end module metapackage_minpack diff --git a/src/fpm/manifest/meta.f90 b/src/fpm/manifest/meta.f90 index 5cfb48c342..17261960eb 100644 --- a/src/fpm/manifest/meta.f90 +++ b/src/fpm/manifest/meta.f90 @@ -45,6 +45,9 @@ module fpm_manifest_metapackages !> Request stdlib support type(metapackage_request_t) :: stdlib + !> fortran-lang minpack + type(metapackage_request_t) :: minpack + end type metapackage_config_t @@ -158,12 +161,15 @@ subroutine new_meta_config(self, table, error) !> The toml table is not checked here because it already passed !> the "new_dependencies" check - call new_request(self%openmp, "openmp", table, error); + call new_request(self%openmp, "openmp", table, error) if (allocated(error)) return call new_request(self%stdlib, "stdlib", table, error) if (allocated(error)) return + call new_request(self%minpack, "minpack", table, error) + if (allocated(error)) return + call new_request(self%mpi, "mpi", table, error) if (allocated(error)) return @@ -178,7 +184,7 @@ logical function is_meta_package(key) select case (key) !> Supported metapackages - case ("openmp","stdlib","mpi") + case ("openmp","stdlib","mpi","minpack") is_meta_package = .true. case default diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 438ceee5f0..a763cb9444 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -19,7 +19,7 @@ module fpm_meta use fpm_model use fpm_command_line use fpm_manifest_dependency, only: dependency_config_t -use fpm_git, only : git_target_branch +use fpm_git, only : git_target_branch, git_target_tag use fpm_manifest, only: package_config_t use fpm_environment, only: get_env,os_is_unix use fpm_filesystem, only: run, get_temp_filename, getline, exists, canon_path, is_dir, get_dos_path @@ -153,9 +153,10 @@ subroutine init_from_name(this,name,compiler,error) !> Initialize metapackage by name select case(name) - case("openmp"); call init_openmp(this,compiler,error) - case("stdlib"); call init_stdlib(this,compiler,error) - case("mpi"); call init_mpi (this,compiler,error) + case("openmp"); call init_openmp (this,compiler,error) + case("stdlib"); call init_stdlib (this,compiler,error) + case("minpack"); call init_minpack(this,compiler,error) + case("mpi"); call init_mpi (this,compiler,error) case default call syntax_error(error, "Package "//name//" is not supported in [metapackages]") return @@ -216,6 +217,30 @@ subroutine init_openmp(this,compiler,error) end subroutine init_openmp +!> Initialize minpack metapackage for the current system +subroutine init_minpack(this,compiler,error) + class(metapackage_t), intent(inout) :: this + type(compiler_t), intent(in) :: compiler + type(error_t), allocatable, intent(out) :: error + + !> Cleanup + call destroy(this) + + !> minpack is queried as a dependency from the official repository + this%has_dependencies = .true. + + allocate(this%dependency(1)) + + !> 1) minpack. There are no true releases currently. Fetch HEAD + this%dependency(1)%name = "minpack" + this%dependency(1)%git = git_target_tag("https://github.com/fortran-lang/minpack", "v2.0.0-rc.1") + if (.not.allocated(this%dependency(1)%git)) then + call fatal_error(error,'cannot initialize git repo dependency for minpack metapackage') + return + end if + +end subroutine init_minpack + !> Initialize stdlib metapackage for the current system subroutine init_stdlib(this,compiler,error) class(metapackage_t), intent(inout) :: this @@ -408,6 +433,13 @@ subroutine resolve_metapackage_model(model,package,settings,error) if (allocated(error)) return endif + ! stdlib + if (package%meta%minpack%on) then + call add_metapackage_model(model,package,settings,"minpack",error) + if (allocated(error)) return + endif + + ! Stdlib is not 100% thread safe. print a warning to the user if (package%meta%stdlib%on .and. package%meta%openmp%on) then write(stdout,'(a)')' both openmp and stdlib requested: some functions may not be thread-safe!' From 6d6411c8e13ec76087781c05f66da8764752c886 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 25 May 2023 11:17:39 +0200 Subject: [PATCH 218/304] always search `.exe` runner versions --- src/fpm_meta.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index a763cb9444..388757ba8a 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -837,7 +837,7 @@ subroutine get_mpi_runner(command,verbose,error) logical, intent(in) :: verbose type(error_t), allocatable, intent(out) :: error - character(*), parameter :: try(*) = ['mpiexec','mpirun '] + character(*), parameter :: try(*) = ['mpiexec ','mpirun ','mpiexec.exe','mpirun.exe '] integer :: itri logical :: success From e7d7ac88c956c69a912c6faf97b9f85d76fe039e Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 27 May 2023 16:57:32 +0700 Subject: [PATCH 219/304] Clean up fpm help new and add --help and --version to fpm help publish --- src/fpm_command_line.f90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index f7a0b1380d..9e1a8e50d1 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -1125,13 +1125,15 @@ subroutine set_help() help_new=[character(len=80) :: & 'NAME ', & ' new(1) - the fpm(1) subcommand to initialize a new project ', & + ' ', & 'SYNOPSIS ', & - ' fpm new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & - ' [--full|--bare][--backfill] ', & + ' fpm new NAME [[--lib|--src] [--app] [--test] [--example]]| ', & + ' [--full|--bare][--backfill] ', & ' fpm new --help|--version ', & ' ', & 'DESCRIPTION ', & ' "fpm new" creates and populates a new programming project directory. ', & + ' ', & ' It ', & ' o creates a directory with the specified name ', & ' o runs the command "git init" in that directory ', & @@ -1361,6 +1363,8 @@ subroutine set_help() 'SYNOPSIS', & ' fpm publish [--token TOKEN]', & '', & + ' fpm publish --help|--version', & + '', & 'DESCRIPTION', & ' Collect relevant source files and upload package to the registry.', & ' It is mandatory to provide a token. The token can be generated on the', & @@ -1369,6 +1373,8 @@ subroutine set_help() 'OPTIONS', & ' --show-package-version show package version without publishing', & ' --show-form-data show sent form data without publishing', & + ' --help print this help and exit', & + ' --version print program version information and exit', & '' ] end subroutine set_help From 17fb88c9c0f692be06cba325358d7391bfc23fea Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 27 May 2023 17:12:03 +0700 Subject: [PATCH 220/304] Rename --show-form-data to --show-upload-data --- src/fpm/cmd/publish.f90 | 16 ++++++++-------- src/fpm_command_line.f90 | 12 ++++++------ test/cli_test/cli_test.f90 | 16 ++++++++-------- 3 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index dc83880f14..97b1e6d0d8 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -30,7 +30,7 @@ subroutine cmd_publish(settings) type(fpm_model_t) :: model type(error_t), allocatable :: error type(version_t), allocatable :: version - type(string_t), allocatable :: form_data(:) + type(string_t), allocatable :: upload_data(:) character(len=:), allocatable :: tmp_file type(downloader_t) :: downloader integer :: i @@ -61,22 +61,22 @@ subroutine cmd_publish(settings) end if end do - form_data = [ & + upload_data = [ & string_t('package_name="'//package%name//'"'), & string_t('package_license="'//package%license//'"'), & string_t('package_version="'//version%s()//'"') & & ] - if (allocated(settings%token)) form_data = [form_data, string_t('upload_token="'//settings%token//'"')] + if (allocated(settings%token)) upload_data = [upload_data, string_t('upload_token="'//settings%token//'"')] 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=@"'//tmp_file//'"')] + upload_data = [upload_data, string_t('tarball=@"'//tmp_file//'"')] - if (settings%show_form_data) then - do i = 1, size(form_data) - print *, form_data(i)%s + if (settings%show_upload_data) then + do i = 1, size(upload_data) + print *, upload_data(i)%s end do return end if @@ -84,7 +84,7 @@ subroutine cmd_publish(settings) ! Make sure a token is provided for publishing. if (.not. allocated(settings%token)) call fpm_stop(1, 'No token provided.') - call downloader%upload_form(official_registry_base_url//'/packages', form_data, error) + call downloader%upload_form(official_registry_base_url//'/packages', upload_data, error) if (allocated(error)) call fpm_stop(1, '*cmd_publish* Upload error: '//error%message) end end diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 9e1a8e50d1..9141e36741 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -120,7 +120,7 @@ module fpm_command_line type, extends(fpm_build_settings) :: fpm_publish_settings logical :: show_package_version = .false. - logical :: show_form_data = .false. + logical :: show_upload_data = .false. character(len=:), allocatable :: token end type @@ -620,7 +620,7 @@ subroutine get_command_line_settings(cmd_settings) case('publish') call set_args(common_args // compiler_args //'& & --show-package-version F & - & --show-form-data F & + & --show-upload-data F & & --token " " & & --list F & & --show-model F & @@ -637,7 +637,7 @@ subroutine get_command_line_settings(cmd_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'), & + & show_upload_data = lget('show-upload-data'), & & profile=val_profile,& & prune=.not.lget('no-prune'), & & compiler=val_compiler, & @@ -754,7 +754,7 @@ subroutine set_help() ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & ' [options] ', & ' clean [--skip] [--all] ', & - ' publish [--show-package-version] [--show-form-data] [--token TOKEN] ', & + ' publish [--show-package-version] [--show-upload-data] [--token TOKEN] ', & ' '] help_usage=[character(len=80) :: & '' ] @@ -878,7 +878,7 @@ subroutine set_help() ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & ' [options] ', & ' clean [--skip] [--all] ', & - ' publish [--show-package-version] [--show-form-data] [--token TOKEN] ', & + ' publish [--show-package-version] [--show-upload-data] [--token TOKEN] ', & ' ', & 'SUBCOMMAND OPTIONS ', & ' -C, --directory PATH', & @@ -1372,7 +1372,7 @@ subroutine set_help() '', & 'OPTIONS', & ' --show-package-version show package version without publishing', & - ' --show-form-data show sent form data without publishing', & + ' --show-upload-data show uploaded data without publishing', & ' --help print this help and exit', & ' --version print program version information and exit', & '' ] diff --git a/test/cli_test/cli_test.f90 b/test/cli_test/cli_test.f90 index dfc94d4daa..ca24b12122 100644 --- a/test/cli_test/cli_test.f90 +++ b/test/cli_test/cli_test.f90 @@ -30,12 +30,12 @@ program main logical :: c_s,act_c_s ; namelist/act_cli/act_c_s logical :: c_a,act_c_a ; namelist/act_cli/act_c_a logical :: show_v,act_show_v ; namelist/act_cli/act_show_v -logical :: show_f_d,act_show_f_d; namelist/act_cli/act_show_f_d +logical :: show_u_d,act_show_u_d; namelist/act_cli/act_show_u_d character(len=:), allocatable :: token, act_token ; namelist/act_cli/act_token character(len=:), allocatable :: profile,act_profile ; namelist/act_cli/act_profile character(len=:), allocatable :: args,act_args ; namelist/act_cli/act_args -namelist/expected/cmd,cstat,estat,w_e,w_t,c_s,c_a,name,profile,args,show_v,show_f_d,token +namelist/expected/cmd,cstat,estat,w_e,w_t,c_s,c_a,name,profile,args,show_v,show_u_d,token integer :: lun logical,allocatable :: tally(:) logical,allocatable :: subtally(:) @@ -75,7 +75,7 @@ program main '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 --show-upload-data", SHOW_U_D=T, NAME=, token="abc",ARGS="",', & 'CMD="publish --token abc", NAME=, token="abc",ARGS="",', & ' ' ] character(len=256) :: readme(3) @@ -110,7 +110,7 @@ program main c_s=.false. ! --skip c_a=.false. ! --all show_v=.false. ! --show-package-version - show_f_d=.false. ! --show-form-data + show_u_d=.false. ! --show-upload-data token='' ! --token TOKEN args=repeat(' ',132) ! -- ARGS cmd=repeat(' ',132) ! the command line arguments to test @@ -132,7 +132,7 @@ program main act_c_s=.false. act_c_a=.false. act_show_v=.false. - act_show_f_d=.false. + act_show_u_d=.false. act_token='' act_args=repeat(' ',132) read(lun,nml=act_cli,iostat=ios,iomsg=message) @@ -148,7 +148,7 @@ program main call test_test('WITH_TESTED',act_w_t.eqv.w_t) call test_test('WITH_TEST',act_w_t.eqv.w_t) call test_test('SHOW-PACKAGE-VERSION',act_show_v.eqv.show_v) - call test_test('SHOW-FORM-DATA',act_show_f_d.eqv.show_f_d) + call test_test('SHOW-UPLOAD-DATA',act_show_u_d.eqv.show_u_d) call test_test('TOKEN',act_token==token) call test_test('ARGS',act_args==args) if(all(subtally))then @@ -237,7 +237,7 @@ subroutine parse() act_c_s=.false. act_c_a=.false. act_show_v=.false. -act_show_f_d=.false. +act_show_u_d=.false. act_token='' act_profile='' @@ -262,7 +262,7 @@ subroutine parse() type is (fpm_install_settings) type is (fpm_publish_settings) act_show_v=settings%show_package_version - act_show_f_d=settings%show_form_data + act_show_u_d=settings%show_upload_data act_token=settings%token end select From 4aed890ec51b0ce289aeb02665f586df43313988 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 27 May 2023 17:17:30 +0700 Subject: [PATCH 221/304] Clean up fpm help list --- src/fpm_command_line.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 9141e36741..d40e66d5ba 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -958,7 +958,7 @@ subroutine set_help() ' list(1) - list summary of fpm(1) subcommands ', & ' ', & 'SYNOPSIS ', & - ' fpm list [-list] ', & + ' fpm list ', & ' ', & ' fpm list --help|--version ', & ' ', & From 2f2e4717d61124d225a6153b83763b233c70527d Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 28 May 2023 09:21:17 +0700 Subject: [PATCH 222/304] Include steps in help --- src/fpm/cmd/publish.f90 | 8 ++++---- src/fpm_command_line.f90 | 26 ++++++++++++++++++++++---- 2 files changed, 26 insertions(+), 8 deletions(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index 97b1e6d0d8..8ff3a7d7da 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -44,16 +44,16 @@ subroutine cmd_publish(settings) print *, version%s(); return end if - ! Build model to obtain dependency tree. - call build_model(model, settings%fpm_build_settings, package, error) - if (allocated(error)) call fpm_stop(1, '*cmd_build* Model error: '//error%message) - !> Checks before uploading the package. if (.not. allocated(package%license)) call fpm_stop(1, 'No license specified in fpm.toml.') if (.not. allocated(version)) call fpm_stop(1, 'No version specified in fpm.toml.') if (version%s() == '0') call fpm_stop(1, 'Invalid version: "'//version%s()//'".') if (.not. exists('fpm.toml')) call fpm_stop(1, "Cannot find 'fpm.toml' file. Are you in the project root?") + ! Build model to obtain dependency tree. + call build_model(model, settings%fpm_build_settings, package, error) + if (allocated(error)) call fpm_stop(1, '*cmd_build* Model error: '//error%message) + ! Check if package contains git dependencies. Only publish packages without git dependencies. do i = 1, model%deps%ndep if (allocated(model%deps%dep(i)%git)) then diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index d40e66d5ba..15e93d685c 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -1361,20 +1361,38 @@ subroutine set_help() ' publish(1) - publish package to the registry', & '', & 'SYNOPSIS', & - ' fpm publish [--token TOKEN]', & + ' fpm publish [--token TOKEN] [--show-package-version] [--show-upload-data]', & '', & ' fpm publish --help|--version', & '', & 'DESCRIPTION', & - ' Collect relevant source files and upload package to the registry.', & - ' It is mandatory to provide a token. The token can be generated on the', & - ' registry website and will be linked to your username and namespace.', & + ' Follow the steps to create a tarball and upload the package to the registry:', & + '', & + ' 1. Register on the website (https://registry-frontend.vercel.app/).', & + ' 2. Create a namespace. Uploaded packages must be assigned to a unique', & + ' namespace to avoid conflicts among packages with similar names. A', & + ' namespace can accommodate multiple packages.', & + ' 3. Create a token for that namespace. A token is linked to your username', & + ' and is used to authenticate you during the upload process. Do not share', & + ' the token with others.', & + ' 4. Run fpm publish --token TOKEN to upload the package to the registry.', & + ' But be aware that the upload is permanent. An uploaded package cannot be', & + ' deleted.', & + '', & + ' See documentation (https://fpm.fortran-lang.org/en/spec/publish.html) for', & + ' more information regarding the package upload.', & '', & 'OPTIONS', & ' --show-package-version show package version without publishing', & ' --show-upload-data show uploaded data without publishing', & ' --help print this help and exit', & ' --version print program version information and exit', & + '', & + 'EXAMPLES', & + '', & + ' fpm publish --show-package-version # show package version without publishing', & + ' fpm publish --show-upload-data # show upload data without publishing', & + ' fpm publish --token TOKEN # upload package to the registry using TOKEN', & '' ] end subroutine set_help From c3823ce9c377aae6b9dd69729dfa30df4486bf4e Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 28 May 2023 10:19:21 +0700 Subject: [PATCH 223/304] Check for non-empty token --- src/fpm/cmd/publish.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index 8ff3a7d7da..80cb3d82e9 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -82,7 +82,11 @@ subroutine cmd_publish(settings) end if ! Make sure a token is provided for publishing. - if (.not. allocated(settings%token)) call fpm_stop(1, 'No token provided.') + if (allocated(settings%token)) then + if (settings%token == '') call fpm_stop(1, 'No token provided.') + else + call fpm_stop(1, 'No token provided.') + end if call downloader%upload_form(official_registry_base_url//'/packages', upload_data, error) if (allocated(error)) call fpm_stop(1, '*cmd_publish* Upload error: '//error%message) From a7097ae005ecec348d7c219859e125ee4cddaae6 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 28 May 2023 10:31:06 +0700 Subject: [PATCH 224/304] Improve error message for git dependencies --- src/fpm/cmd/publish.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index 80cb3d82e9..e149c3075e 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -57,7 +57,8 @@ subroutine cmd_publish(settings) ! Check if package contains git dependencies. Only publish packages without git dependencies. do i = 1, model%deps%ndep if (allocated(model%deps%dep(i)%git)) then - call fpm_stop(1, "Do not publish packages containing git dependencies. '"//model%deps%dep(i)%name//"' is a git dependency.") + call fpm_stop(1, 'Do not publish packages containing git dependencies. '// & + & "Please upload '"//model%deps%dep(i)%name//"' to the registry first.") end if end do From 41166f8b95d879f047835e64ace5b3883e0018af Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 28 May 2023 12:03:52 +0700 Subject: [PATCH 225/304] Add link to documentation for package usage --- src/fpm_command_line.f90 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 15e93d685c..57e804035b 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -1366,7 +1366,7 @@ subroutine set_help() ' fpm publish --help|--version', & '', & 'DESCRIPTION', & - ' Follow the steps to create a tarball and upload the package to the registry:', & + ' Follow the steps to create a tarball and upload a package to the registry:', & '', & ' 1. Register on the website (https://registry-frontend.vercel.app/).', & ' 2. Create a namespace. Uploaded packages must be assigned to a unique', & @@ -1379,8 +1379,13 @@ subroutine set_help() ' But be aware that the upload is permanent. An uploaded package cannot be', & ' deleted.', & '', & - ' See documentation (https://fpm.fortran-lang.org/en/spec/publish.html) for', & - ' more information regarding the package upload.', & + ' See documentation for more information regarding the package upload and usage:', & + '', & + ' Package upload:', & + ' https://fpm.fortran-lang.org/en/spec/publish.html', & + '', & + ' Package usage:', & + ' https://fpm.fortran-lang.org/en/spec/manifest.html#dependencies-from-a-registry', & '', & 'OPTIONS', & ' --show-package-version show package version without publishing', & From c5ab931e173fe34c787d17e53b99e7f0ecc74af7 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 28 May 2023 12:47:30 +0700 Subject: [PATCH 226/304] Require module-naming --- src/fpm/cmd/publish.f90 | 2 ++ src/fpm_command_line.f90 | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index e149c3075e..b84fba640a 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -46,6 +46,8 @@ subroutine cmd_publish(settings) !> Checks before uploading the package. if (.not. allocated(package%license)) call fpm_stop(1, 'No license specified in fpm.toml.') + if (.not. package%build%module_naming) call fpm_stop(1, 'The package does not meet the module naming requirements. '// & + & 'Please set "module_naming = true" in fpm.toml [build] or specify a custom module prefix.') if (.not. allocated(version)) call fpm_stop(1, 'No version specified in fpm.toml.') if (version%s() == '0') call fpm_stop(1, 'Invalid version: "'//version%s()//'".') if (.not. exists('fpm.toml')) call fpm_stop(1, "Cannot find 'fpm.toml' file. Are you in the project root?") diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 57e804035b..22ba9c0843 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -754,7 +754,7 @@ subroutine set_help() ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & ' [options] ', & ' clean [--skip] [--all] ', & - ' publish [--show-package-version] [--show-upload-data] [--token TOKEN] ', & + ' publish [--show-package-version] [--show-upload-data] [--token TOKEN] ', & ' '] help_usage=[character(len=80) :: & '' ] From 8eadf4ae2bbff9f08f591d467d873fe4de5c90d6 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 29 May 2023 09:26:57 +0700 Subject: [PATCH 227/304] Clean up code and delete file after use --- src/fpm/cmd/publish.f90 | 29 ++++++++++++++++------------- src/fpm/git.f90 | 2 +- 2 files changed, 17 insertions(+), 14 deletions(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index b84fba640a..72714206b7 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -8,7 +8,7 @@ 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_temp_filename + use fpm_filesystem, only: exists, join_path, get_temp_filename, delete_file use fpm_git, only: git_archive use fpm_downloader, only: downloader_t use fpm_strings, only: string_t @@ -64,34 +64,37 @@ subroutine cmd_publish(settings) end if end do + tmp_file = get_temp_filename() + call git_archive('.', tmp_file, error) + if (allocated(error)) call fpm_stop(1, '*cmd_publish* Archive error: '//error%message) + upload_data = [ & - string_t('package_name="'//package%name//'"'), & - string_t('package_license="'//package%license//'"'), & - string_t('package_version="'//version%s()//'"') & - & ] + & string_t('package_name="'//package%name//'"'), & + & string_t('package_license="'//package%license//'"'), & + & string_t('package_version="'//version%s()//'"'), & + & string_t('tarball=@"'//tmp_file//'"') & + & ] if (allocated(settings%token)) upload_data = [upload_data, string_t('upload_token="'//settings%token//'"')] - tmp_file = get_temp_filename() - call git_archive('.', tmp_file, error) - if (allocated(error)) call fpm_stop(1, '*cmd_publish* Pack error: '//error%message) - upload_data = [upload_data, string_t('tarball=@"'//tmp_file//'"')] - if (settings%show_upload_data) then do i = 1, size(upload_data) print *, upload_data(i)%s end do - return + call delete_file(tmp_file); return end if ! Make sure a token is provided for publishing. if (allocated(settings%token)) then - if (settings%token == '') call fpm_stop(1, 'No token provided.') + if (settings%token == '') then + call delete_file(tmp_file); call fpm_stop(1, 'No token provided.') + end if else - call fpm_stop(1, 'No token provided.') + call delete_file(tmp_file); call fpm_stop(1, 'No token provided.') end if call downloader%upload_form(official_registry_base_url//'/packages', upload_data, error) + call delete_file(tmp_file) if (allocated(error)) call fpm_stop(1, '*cmd_publish* Upload error: '//error%message) end end diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index b1cd1d8376..ad86ca3f73 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -328,7 +328,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 '// destination, 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 From 9c64d18bfba07779a4fa83cb83e072d16142e4ca Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 29 May 2023 10:43:33 +0700 Subject: [PATCH 228/304] Add dry run option, add tests --- src/fpm/cmd/publish.f90 | 9 ++++++++- src/fpm_command_line.f90 | 12 ++++++++++-- test/cli_test/cli_test.f90 | 9 ++++++++- 3 files changed, 26 insertions(+), 4 deletions(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index 72714206b7..0e0c85c663 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -81,7 +81,6 @@ subroutine cmd_publish(settings) do i = 1, size(upload_data) print *, upload_data(i)%s end do - call delete_file(tmp_file); return end if ! Make sure a token is provided for publishing. @@ -93,6 +92,14 @@ subroutine cmd_publish(settings) call delete_file(tmp_file); call fpm_stop(1, 'No token provided.') end if + ! Perform network request and validate package on the backend as soon as + ! https://github.com/fortran-lang/registry/issues/41 is resolved. + if (settings%is_dry_run) then + print *, 'Dry run successful.' + print *, '' + print *, 'tarball generated for upload: ', tmp_file; return + end if + call downloader%upload_form(official_registry_base_url//'/packages', upload_data, error) call delete_file(tmp_file) if (allocated(error)) call fpm_stop(1, '*cmd_publish* Upload error: '//error%message) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 22ba9c0843..2537f701bd 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -121,6 +121,7 @@ module fpm_command_line type, extends(fpm_build_settings) :: fpm_publish_settings logical :: show_package_version = .false. logical :: show_upload_data = .false. + logical :: is_dry_run = .false. character(len=:), allocatable :: token end type @@ -621,6 +622,7 @@ subroutine get_command_line_settings(cmd_settings) call set_args(common_args // compiler_args //'& & --show-package-version F & & --show-upload-data F & + & --dry-run F & & --token " " & & --list F & & --show-model F & @@ -638,6 +640,7 @@ subroutine get_command_line_settings(cmd_settings) cmd_settings = fpm_publish_settings( & & show_package_version = lget('show-package-version'), & & show_upload_data = lget('show-upload-data'), & + & is_dry_run = lget('dry-run'), & & profile=val_profile,& & prune=.not.lget('no-prune'), & & compiler=val_compiler, & @@ -754,7 +757,8 @@ subroutine set_help() ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & ' [options] ', & ' clean [--skip] [--all] ', & - ' publish [--show-package-version] [--show-upload-data] [--token TOKEN] ', & + ' publish [--token TOKEN] [--show-package-version] [--show-upload-data] ', & + ' [--dry-run] ', & ' '] help_usage=[character(len=80) :: & '' ] @@ -878,7 +882,8 @@ subroutine set_help() ' install [--profile PROF] [--flag FFLAGS] [--no-rebuild] [--prefix PATH] ', & ' [options] ', & ' clean [--skip] [--all] ', & - ' publish [--show-package-version] [--show-upload-data] [--token TOKEN] ', & + ' publish [--token TOKEN] [--show-package-version] [--show-upload-data] ', & + ' [--dry-run] ', & ' ', & 'SUBCOMMAND OPTIONS ', & ' -C, --directory PATH', & @@ -1362,6 +1367,7 @@ subroutine set_help() '', & 'SYNOPSIS', & ' fpm publish [--token TOKEN] [--show-package-version] [--show-upload-data]', & + ' [--dry-run] ', & '', & ' fpm publish --help|--version', & '', & @@ -1390,6 +1396,7 @@ subroutine set_help() 'OPTIONS', & ' --show-package-version show package version without publishing', & ' --show-upload-data show uploaded data without publishing', & + ' --dry-run create tarball for revision without publishing', & ' --help print this help and exit', & ' --version print program version information and exit', & '', & @@ -1397,6 +1404,7 @@ subroutine set_help() '', & ' fpm publish --show-package-version # show package version without publishing', & ' fpm publish --show-upload-data # show upload data without publishing', & + ' fpm publish --dry-run # create tarball without publishing', & ' fpm publish --token TOKEN # upload package to the registry using TOKEN', & '' ] end subroutine set_help diff --git a/test/cli_test/cli_test.f90 b/test/cli_test/cli_test.f90 index ca24b12122..f5336b62ca 100644 --- a/test/cli_test/cli_test.f90 +++ b/test/cli_test/cli_test.f90 @@ -31,11 +31,12 @@ program main logical :: c_a,act_c_a ; namelist/act_cli/act_c_a logical :: show_v,act_show_v ; namelist/act_cli/act_show_v logical :: show_u_d,act_show_u_d; namelist/act_cli/act_show_u_d +logical :: dry_run,act_dry_run ; namelist/act_cli/act_dry_run character(len=:), allocatable :: token, act_token ; namelist/act_cli/act_token character(len=:), allocatable :: profile,act_profile ; namelist/act_cli/act_profile character(len=:), allocatable :: args,act_args ; namelist/act_cli/act_args -namelist/expected/cmd,cstat,estat,w_e,w_t,c_s,c_a,name,profile,args,show_v,show_u_d,token +namelist/expected/cmd,cstat,estat,w_e,w_t,c_s,c_a,name,profile,args,show_v,show_u_d,dry_run,token integer :: lun logical,allocatable :: tally(:) logical,allocatable :: subtally(:) @@ -76,6 +77,7 @@ program main '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-upload-data", SHOW_U_D=T, NAME=, token="abc",ARGS="",', & +'CMD="publish --token abc --dry-run", DRY_RUN=T, NAME=, token="abc",ARGS="",', & 'CMD="publish --token abc", NAME=, token="abc",ARGS="",', & ' ' ] character(len=256) :: readme(3) @@ -111,6 +113,7 @@ program main c_a=.false. ! --all show_v=.false. ! --show-package-version show_u_d=.false. ! --show-upload-data + dry_run=.false. ! --dry-run token='' ! --token TOKEN args=repeat(' ',132) ! -- ARGS cmd=repeat(' ',132) ! the command line arguments to test @@ -133,6 +136,7 @@ program main act_c_a=.false. act_show_v=.false. act_show_u_d=.false. + act_dry_run=.false. act_token='' act_args=repeat(' ',132) read(lun,nml=act_cli,iostat=ios,iomsg=message) @@ -149,6 +153,7 @@ program main call test_test('WITH_TEST',act_w_t.eqv.w_t) call test_test('SHOW-PACKAGE-VERSION',act_show_v.eqv.show_v) call test_test('SHOW-UPLOAD-DATA',act_show_u_d.eqv.show_u_d) + call test_test('DRY-RUN',act_dry_run.eqv.dry_run) call test_test('TOKEN',act_token==token) call test_test('ARGS',act_args==args) if(all(subtally))then @@ -238,6 +243,7 @@ subroutine parse() act_c_a=.false. act_show_v=.false. act_show_u_d=.false. +act_dry_run=.false. act_token='' act_profile='' @@ -263,6 +269,7 @@ subroutine parse() type is (fpm_publish_settings) act_show_v=settings%show_package_version act_show_u_d=settings%show_upload_data + act_dry_run=settings%is_dry_run act_token=settings%token end select From 01152069082859c8218e4ec78f3f148a607afa38 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 29 May 2023 19:11:49 +0700 Subject: [PATCH 229/304] Add back return --- src/fpm/cmd/publish.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index 0e0c85c663..a81e2e2c92 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -81,6 +81,7 @@ subroutine cmd_publish(settings) do i = 1, size(upload_data) print *, upload_data(i)%s end do + return end if ! Make sure a token is provided for publishing. @@ -97,7 +98,8 @@ subroutine cmd_publish(settings) if (settings%is_dry_run) then print *, 'Dry run successful.' print *, '' - print *, 'tarball generated for upload: ', tmp_file; return + print *, 'tarball generated for upload: ', tmp_file + return end if call downloader%upload_form(official_registry_base_url//'/packages', upload_data, error) From 0c860f28d106f659243b031b8364752c44020ac6 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 30 May 2023 15:40:38 +0700 Subject: [PATCH 230/304] Remove these these --- src/fpm_command_line.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 2537f701bd..94a385955d 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -169,7 +169,7 @@ module fpm_command_line ' --flag FFLAGS selects compile arguments for the build, the default value is',& ' set by the FPM_FFLAGS environment variable. These are added ',& ' to the profile options if --profile is specified, else these ',& - ' these options override the defaults. Note object and .mod ',& + ' options override the defaults. Note object and .mod ',& ' directory locations are always built in. ',& ' --c-flag CFLAGS selects compile arguments specific for C source in the build.',& ' The default value is set by the FPM_CFLAGS environment ',& From 91c425ec40b59b73d3944db1c3fef1b688b30ec4 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 30 May 2023 19:00:12 +0700 Subject: [PATCH 231/304] Add verbose mode and --token TOKEN to --dry-run example --- src/fpm/cmd/publish.f90 | 23 ++++++++++++++++++----- src/fpm_command_line.f90 | 21 +++++++++++---------- 2 files changed, 29 insertions(+), 15 deletions(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index a81e2e2c92..a1b2981372 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -78,10 +78,7 @@ subroutine cmd_publish(settings) if (allocated(settings%token)) upload_data = [upload_data, string_t('upload_token="'//settings%token//'"')] if (settings%show_upload_data) then - do i = 1, size(upload_data) - print *, upload_data(i)%s - end do - return + call print_upload_data(upload_data); return end if ! Make sure a token is provided for publishing. @@ -93,7 +90,13 @@ subroutine cmd_publish(settings) call delete_file(tmp_file); call fpm_stop(1, 'No token provided.') end if - ! Perform network request and validate package on the backend as soon as + if (settings%verbose) then + print *, '' + call print_upload_data(upload_data) + print *, '' + end if + + ! Perform network request and validate package, token etc. on the backend once ! https://github.com/fortran-lang/registry/issues/41 is resolved. if (settings%is_dry_run) then print *, 'Dry run successful.' @@ -106,4 +109,14 @@ subroutine cmd_publish(settings) call delete_file(tmp_file) if (allocated(error)) call fpm_stop(1, '*cmd_publish* Upload error: '//error%message) end + + subroutine print_upload_data(upload_data) + type(string_t), intent(in) :: upload_data(:) + integer :: i + + print *, 'Upload data:' + do i = 1, size(upload_data) + print *, upload_data(i)%s + end do + end end diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 94a385955d..f1ced79308 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -758,7 +758,7 @@ subroutine set_help() ' [options] ', & ' clean [--skip] [--all] ', & ' publish [--token TOKEN] [--show-package-version] [--show-upload-data] ', & - ' [--dry-run] ', & + ' [--dry-run] [--verbose] ', & ' '] help_usage=[character(len=80) :: & '' ] @@ -883,7 +883,7 @@ subroutine set_help() ' [options] ', & ' clean [--skip] [--all] ', & ' publish [--token TOKEN] [--show-package-version] [--show-upload-data] ', & - ' [--dry-run] ', & + ' [--dry-run] [--verbose] ', & ' ', & 'SUBCOMMAND OPTIONS ', & ' -C, --directory PATH', & @@ -1367,7 +1367,7 @@ subroutine set_help() '', & 'SYNOPSIS', & ' fpm publish [--token TOKEN] [--show-package-version] [--show-upload-data]', & - ' [--dry-run] ', & + ' [--dry-run] [--verbose] ', & '', & ' fpm publish --help|--version', & '', & @@ -1385,7 +1385,7 @@ subroutine set_help() ' But be aware that the upload is permanent. An uploaded package cannot be', & ' deleted.', & '', & - ' See documentation for more information regarding the package upload and usage:', & + ' See documentation for more information regarding package upload and usage:', & '', & ' Package upload:', & ' https://fpm.fortran-lang.org/en/spec/publish.html', & @@ -1395,17 +1395,18 @@ subroutine set_help() '', & 'OPTIONS', & ' --show-package-version show package version without publishing', & - ' --show-upload-data show uploaded data without publishing', & - ' --dry-run create tarball for revision without publishing', & + ' --show-upload-data show upload data without publishing', & + ' --dry-run perform dry run without publishing', & ' --help print this help and exit', & ' --version print program version information and exit', & + ' --verbose print more information', & '', & 'EXAMPLES', & '', & - ' fpm publish --show-package-version # show package version without publishing', & - ' fpm publish --show-upload-data # show upload data without publishing', & - ' fpm publish --dry-run # create tarball without publishing', & - ' fpm publish --token TOKEN # upload package to the registry using TOKEN', & + ' fpm publish --show-package-version # show package version without publishing', & + ' fpm publish --show-upload-data # show upload data without publishing', & + ' fpm publish --token TOKEN --dry-run # perform dry run without publishing', & + ' fpm publish --token TOKEN # upload package to the registry', & '' ] end subroutine set_help From 4c0d5a6f6667bc8e4863acd7afec2d6c87c32f60 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 30 May 2023 19:19:55 +0700 Subject: [PATCH 232/304] Do not imply manual upload --- src/fpm/cmd/publish.f90 | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index a1b2981372..5439f82ba5 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -99,10 +99,7 @@ subroutine cmd_publish(settings) ! Perform network request and validate package, token etc. on the backend once ! https://github.com/fortran-lang/registry/issues/41 is resolved. if (settings%is_dry_run) then - print *, 'Dry run successful.' - print *, '' - print *, 'tarball generated for upload: ', tmp_file - return + print *, 'Dry run successful. ', 'Generated tarball: ', tmp_file; return end if call downloader%upload_form(official_registry_base_url//'/packages', upload_data, error) From cc7cedb5f6d7acf572c592f497d40d9e2cf1808f Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 30 May 2023 19:21:10 +0700 Subject: [PATCH 233/304] Only use one string --- src/fpm/cmd/publish.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index 5439f82ba5..22c283dac8 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -99,7 +99,7 @@ subroutine cmd_publish(settings) ! Perform network request and validate package, token etc. on the backend once ! https://github.com/fortran-lang/registry/issues/41 is resolved. if (settings%is_dry_run) then - print *, 'Dry run successful. ', 'Generated tarball: ', tmp_file; return + print *, 'Dry run successful. Generated tarball: ', tmp_file; return end if call downloader%upload_form(official_registry_base_url//'/packages', upload_data, error) From 1bae477620cc482a0787fa7617266baa93612265 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 1 Jun 2023 05:51:07 -0500 Subject: [PATCH 234/304] parse `non_intrinsic` and `intrinsic` `use`d modules --- src/fpm_source_parsing.f90 | 161 ++++++++++++++++++++++++------------- 1 file changed, 107 insertions(+), 54 deletions(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 88c3fc5c10..58d16c0afb 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -27,15 +27,7 @@ module fpm_source_parsing implicit none private -public :: parse_f_source, parse_c_source - -character(15), parameter :: INTRINSIC_MODULE_NAMES(*) = & - ['iso_c_binding ', & - 'iso_fortran_env', & - 'ieee_arithmetic', & - 'ieee_exceptions', & - 'ieee_features ', & - 'omp_lib '] +public :: parse_f_source, parse_c_source, parse_use_statement contains @@ -77,7 +69,7 @@ function parse_f_source(f_filename,error) result(f_source) type(srcfile_t) :: f_source type(error_t), allocatable, intent(out) :: error - logical :: inside_module, inside_interface + logical :: inside_module, inside_interface, using, intrinsic_module integer :: stat integer :: fh, n_use, n_include, n_mod, n_parent, i, j, ic, pass type(string_t), allocatable :: file_lines(:), file_lines_lower(:) @@ -179,59 +171,24 @@ function parse_f_source(f_filename,error) result(f_source) end if ! Process 'USE' statements - if (index(file_lines_lower(i)%s,'use ') == 1 .or. & - index(file_lines_lower(i)%s,'use::') == 1) then - - if (index(file_lines_lower(i)%s,'::') > 0) then - - temp_string = split_n(file_lines_lower(i)%s,delims=':',n=2,stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find used module name',i, & - file_lines_lower(i)%s,index(file_lines_lower(i)%s,'::')) - return - end if + call parse_use_statement(f_filename,i,file_lines_lower(i)%s,using,intrinsic_module,mod_name,error) + if (allocated(error)) return - mod_name = split_n(temp_string,delims=' ,',n=1,stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find used module name',i, & - file_lines_lower(i)%s) - return - end if + if (using) then - else + ! Not a valid module name? + if (.not.is_fortran_name(mod_name)) cycle - mod_name = split_n(file_lines_lower(i)%s,n=2,delims=' ,',stat=stat) - if (stat /= 0) then - call file_parse_error(error,f_filename, & - 'unable to find used module name',i, & - file_lines_lower(i)%s) - return - end if - - end if - - if (.not.is_fortran_name(mod_name)) then - cycle - end if - - if (any([(index(mod_name,trim(INTRINSIC_MODULE_NAMES(j)))>0, & - j=1,size(INTRINSIC_MODULE_NAMES))])) then - cycle - end if + ! Valid intrinsic module: not a dependency + if (intrinsic_module) cycle n_use = n_use + 1 - if (pass == 2) then - - f_source%modules_used(n_use)%s = mod_name - - end if + if (pass == 2) f_source%modules_used(n_use)%s = mod_name cycle - end if + endif ! Process 'INCLUDE' statements ic = index(file_lines_lower(i)%s,'include') @@ -655,5 +612,101 @@ function parse_sequence(string,t1,t2,t3,t4) result(found) end function parse_sequence +! Process 'USE' statements + +! USE [, intrinsic] :: module_name [, only: only_list] +! USE [, non_intrinsic] :: module_name [, only: only_list] +subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_name,error) + character(*), intent(in) :: f_filename,line + integer, intent(in) :: i ! line number + logical, intent(out) :: use_stmt,is_intrinsic + character(:), allocatable, intent(out) :: module_name + type(error_t), allocatable, intent(out) :: error + + character(15), parameter :: INTRINSIC_NAMES(*) = & + ['iso_c_binding ', & + 'iso_fortran_env', & + 'ieee_arithmetic', & + 'ieee_exceptions', & + 'ieee_features ', & + 'omp_lib '] + + character(len=:), allocatable :: lowercase,temp_string + integer :: colons,intr,nonintr,j,stat + logical :: has_intrinsic_name + + use_stmt = .false. + is_intrinsic = .false. + if (len_trim(line)<=0) return + + ! Preprocess: lowercase, remove heading spaces + lowercase = lower(trim(adjustl(line))) + + ! 'use' should be the first string in the adjustl line + use_stmt = index(lowercase,'use')==1; if (.not.use_stmt) return + colons = index(lowercase,'::') + nonintr = 0 + intr = 0 + intrinsicness: if (colons>3) then + + end if intrinsicness + + ! If declared intrinsic, check that it is true + print *, 'colons=',colons + print *, 'intr=',intr + print *, 'nonintr=',nonintr + + if (colons>3) then + + ! If there is an intrinsic/non-intrinsic spec + nonintr = index(lowercase(1:colons-1),'non_intrinsic') + if (nonintr==0) intr = index(lowercase(1:colons-1),'intrinsic') + + + temp_string = split_n(lowercase,delims=':',n=2,stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find used module name',i, & + lowercase,colons) + return + end if + + module_name = split_n(temp_string,delims=' ,',n=1,stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find used module name',i, & + lowercase) + return + end if + + else + + module_name = split_n(lowercase,n=2,delims=' ,',stat=stat) + if (stat /= 0) then + call file_parse_error(error,f_filename, & + 'unable to find used module name',i, & + lowercase) + return + end if + + end if + + ! If declared intrinsic, check that it is true + has_intrinsic_name = any([(index(module_name,trim(INTRINSIC_NAMES(j)))>0, & + j=1,size(INTRINSIC_NAMES))]) + if (intr>0 .and. .not.has_intrinsic_name) then + call file_parse_error(error,f_filename, & + 'module is declared intrinsic but it is not ',i, & + lowercase) + return + endif + + ! Should we treat this as an intrinsic module + is_intrinsic = nonintr==0 .and. & ! not declared non-intrinsic + (intr>0 .or. has_intrinsic_name) + +end subroutine parse_use_statement + + end module fpm_source_parsing From 0ae912b2700c74e69f2cd774897ae89f527a558d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 1 Jun 2023 05:51:20 -0500 Subject: [PATCH 235/304] tests for `non_intrinsic` parsing --- test/fpm_test/test_source_parsing.f90 | 141 +++++++++++++++++++++++++- 1 file changed, 137 insertions(+), 4 deletions(-) diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index b480e76c33..41d7db3a84 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -2,11 +2,12 @@ module test_source_parsing use testsuite, only : new_unittest, unittest_t, error_t, test_failed use fpm_filesystem, only: get_temp_filename - use fpm_source_parsing, only: parse_f_source, parse_c_source + use fpm_source_parsing, only: parse_f_source, parse_c_source, parse_use_statement use fpm_model, only: srcfile_t, FPM_UNIT_PROGRAM, FPM_UNIT_MODULE, & FPM_UNIT_SUBMODULE, FPM_UNIT_SUBPROGRAM, FPM_UNIT_CSOURCE, & FPM_UNIT_CPPSOURCE - use fpm_strings, only: operator(.in.) + use fpm_strings, only: operator(.in.), lower + use fpm_error, only: file_parse_error, fatal_error implicit none private @@ -14,7 +15,6 @@ module test_source_parsing contains - !> Collect all exported unit tests subroutine collect_source_parsing(testsuite) @@ -24,6 +24,7 @@ subroutine collect_source_parsing(testsuite) testsuite = [ & & new_unittest("modules-used", test_modules_used), & & new_unittest("intrinsic-modules-used", test_intrinsic_modules_used), & + & new_unittest("nonintrinsic-modules-used", test_nonintrinsic_modules_used), & & new_unittest("include-stmt", test_include_stmt), & & new_unittest("program", test_program), & & new_unittest("module", test_module), & @@ -42,7 +43,8 @@ subroutine collect_source_parsing(testsuite) & new_unittest("invalid-module", & test_invalid_module, should_fail=.true.), & & new_unittest("invalid-submodule", & - test_invalid_submodule, should_fail=.true.) & + test_invalid_submodule, should_fail=.true.), & + & new_unittest("use-statement",test_use_statement) & ] end subroutine collect_source_parsing @@ -187,6 +189,78 @@ subroutine test_intrinsic_modules_used(error) end subroutine test_intrinsic_modules_used + !> Check that intrinsic module names are not ignored if declared non_intrinsic + subroutine test_nonintrinsic_modules_used(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + integer :: unit + character(:), allocatable :: temp_file + type(srcfile_t), allocatable :: f_source + + allocate(temp_file, source=get_temp_filename()) + + open(file=temp_file, newunit=unit) + write(unit, '(a)') & + & 'program test', & + & ' use, non_intrinsic :: iso_c_binding', & + & ' use, intrinsic :: iso_fortran_env', & + & ' use, non_intrinsic :: ieee_arithmetic', & + & ' use, non_intrinsic :: ieee_exceptions', & + & ' use, non_intrinsic :: ieee_features', & + & ' use, non_intrinsic :: my_module', & + & ' implicit none', & + & 'end program test' + close(unit) + + f_source = parse_f_source(temp_file,error) + if (allocated(error)) then + return + end if + + if (size(f_source%modules_provided) /= 0) then + call test_failed(error,'Unexpected modules_provided - expecting zero') + return + end if + + if (size(f_source%modules_used) /= 5) then + call test_failed(error,'Incorrect number of modules_used - expecting five') + return + end if + + if (.not. ('iso_c_binding' .in. f_source%modules_used)) then + call test_failed(error,'Non-Intrinsic module found in modules_used') + return + end if + + if ('iso_fortran_env' .in. f_source%modules_used) then + call test_failed(error,'Intrinsic module found in modules_used') + return + end if + + if (.not. ('ieee_arithmetic' .in. f_source%modules_used)) then + call test_failed(error,'Non-Intrinsic module found in modules_used') + return + end if + + if (.not. ('ieee_exceptions' .in. f_source%modules_used)) then + call test_failed(error,'Non-Intrinsic module found in modules_used') + return + end if + + if (.not. ('ieee_features' .in. f_source%modules_used)) then + call test_failed(error,'Non-Intrinsic module found in modules_used') + return + end if + + if (.not. ('my_module' .in. f_source%modules_used)) then + call test_failed(error,'Non-Intrinsic module found in modules_used') + return + end if + + end subroutine test_nonintrinsic_modules_used + !> Check parsing of include statements subroutine test_include_stmt(error) @@ -945,6 +1019,65 @@ subroutine test_invalid_submodule(error) end subroutine test_invalid_submodule + !> Parse several USE statements + subroutine test_use_statement(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(*), parameter :: filename='test_use_statement' + character(:), allocatable :: line,module_name + + logical :: used,is_intrinsic + + line = 'use, intrinsic:: iso_fortran_env' + call parse_use_statement(filename,0,line,used,is_intrinsic,module_name,error) + if (allocated(error)) return + + if (.not. (used .and. & + is_intrinsic .and. & + module_name=='iso_fortran_env' .and. & + used)) then + call fatal_error(error,'USE statement failed parsing <'//line//'>') + return + endif + + line = 'use, non_intrinsic :: iso_fortran_env' + call parse_use_statement(filename,0,line,used,is_intrinsic,module_name,error) + if (allocated(error)) return + + if (.not. (used .and. & + (.not.is_intrinsic) .and. & + module_name=='iso_fortran_env' .and. & + used)) then + call fatal_error(error,'USE statement failed parsing <'//line//'>') + return + endif + + line = 'use, non_intrinsic :: my_fortran_module' + call parse_use_statement(filename,0,line,used,is_intrinsic,module_name,error) + if (allocated(error)) return + + if (.not. (used .and. & + (.not.is_intrinsic) .and. & + module_name=='my_fortran_module' .and. & + used)) then + call fatal_error(error,'USE statement failed parsing <'//line//'>') + return + endif + + line = 'use, intrinsic :: my_fortran_module' + call parse_use_statement(filename,0,line,used,is_intrinsic,module_name,error) + + ! This is not an intrinsic module: should detect an error + if (.not. allocated(error)) then + call fatal_error(error,'Did not catch invalid intrinsic module in <'//line//'>') + return + else + deallocate(error) + endif + + end subroutine test_use_statement end module test_source_parsing From 3780d2b09b02b62a3f4a4e4888ba1f8453c13c23 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 1 Jun 2023 05:53:10 -0500 Subject: [PATCH 236/304] cleanup --- src/fpm_source_parsing.f90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 58d16c0afb..12ae899402 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -652,10 +652,6 @@ subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_na end if intrinsicness ! If declared intrinsic, check that it is true - print *, 'colons=',colons - print *, 'intr=',intr - print *, 'nonintr=',nonintr - if (colons>3) then ! If there is an intrinsic/non-intrinsic spec From 89f2004d0c24fd1fed45023d69e227064bcb8917 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 1 Jun 2023 05:53:31 -0500 Subject: [PATCH 237/304] add example package --- example_packages/nonintrinsic/.gitignore | 1 + example_packages/nonintrinsic/app/main.f90 | 6 ++++++ example_packages/nonintrinsic/fpm.toml | 1 + example_packages/nonintrinsic/src/iso_fortran_env.f90 | 4 ++++ 4 files changed, 12 insertions(+) create mode 100644 example_packages/nonintrinsic/.gitignore create mode 100644 example_packages/nonintrinsic/app/main.f90 create mode 100644 example_packages/nonintrinsic/fpm.toml create mode 100644 example_packages/nonintrinsic/src/iso_fortran_env.f90 diff --git a/example_packages/nonintrinsic/.gitignore b/example_packages/nonintrinsic/.gitignore new file mode 100644 index 0000000000..a007feab07 --- /dev/null +++ b/example_packages/nonintrinsic/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/nonintrinsic/app/main.f90 b/example_packages/nonintrinsic/app/main.f90 new file mode 100644 index 0000000000..a45f06d8f7 --- /dev/null +++ b/example_packages/nonintrinsic/app/main.f90 @@ -0,0 +1,6 @@ +program test_nonintr + use, non_intrinsic :: iso_fortran_env + + ! ijk=0 can be read + stop ijk +end program test_nonintr diff --git a/example_packages/nonintrinsic/fpm.toml b/example_packages/nonintrinsic/fpm.toml new file mode 100644 index 0000000000..77e149814d --- /dev/null +++ b/example_packages/nonintrinsic/fpm.toml @@ -0,0 +1 @@ +name = "non-intrinsic" diff --git a/example_packages/nonintrinsic/src/iso_fortran_env.f90 b/example_packages/nonintrinsic/src/iso_fortran_env.f90 new file mode 100644 index 0000000000..20eea596f4 --- /dev/null +++ b/example_packages/nonintrinsic/src/iso_fortran_env.f90 @@ -0,0 +1,4 @@ +module iso_fortran_env + implicit none + integer, parameter :: ijk = 0 +end module iso_fortran_env From 2dd422261bce78ae3c13b32f5ddb82eb41f4635f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 1 Jun 2023 05:54:39 -0500 Subject: [PATCH 238/304] add to CI --- ci/run_tests.sh | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index b0e769b73e..987b282449 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -31,6 +31,10 @@ pushd circular_example "$fpm" build popd +pushd nonintrinsic +"$fpm" build +popd + pushd hello_complex "$fpm" build "$fpm" test From 467eff4956594482e68aebc28f391621ac02d73f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 1 Jun 2023 05:58:56 -0500 Subject: [PATCH 239/304] fix use identification fix use identification Update fpm_source_parsing.f90 --- src/fpm_source_parsing.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 12ae899402..904b9db062 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -643,7 +643,8 @@ subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_na lowercase = lower(trim(adjustl(line))) ! 'use' should be the first string in the adjustl line - use_stmt = index(lowercase,'use')==1; if (.not.use_stmt) return + use_stmt = index(lowercase,'use ')==1 .or. index(lowercase,'use::')==1 .or. index(lowercase,'use,')==1 + if (.not.use_stmt) return colons = index(lowercase,'::') nonintr = 0 intr = 0 From 7f3f7ad4a12e6145fb1d486b6a653094542b7f84 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 1 Jun 2023 13:35:36 +0200 Subject: [PATCH 240/304] Update fpm_source_parsing.f90 --- src/fpm_source_parsing.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 904b9db062..f3d9caa31c 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -612,8 +612,6 @@ function parse_sequence(string,t1,t2,t3,t4) result(found) end function parse_sequence -! Process 'USE' statements - ! USE [, intrinsic] :: module_name [, only: only_list] ! USE [, non_intrinsic] :: module_name [, only: only_list] subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_name,error) @@ -693,7 +691,7 @@ subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_na j=1,size(INTRINSIC_NAMES))]) if (intr>0 .and. .not.has_intrinsic_name) then call file_parse_error(error,f_filename, & - 'module is declared intrinsic but it is not ',i, & + 'module '//module_name//' is declared intrinsic but it is not ',i, & lowercase) return endif @@ -705,5 +703,6 @@ subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_na end subroutine parse_use_statement + end module fpm_source_parsing From 54528c66dfabdc3eae94ab9e24f0e1da9e080cc5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 1 Jun 2023 13:39:54 +0200 Subject: [PATCH 241/304] fix intrinsic module parsing in the next line --- src/fpm_source_parsing.f90 | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index f3d9caa31c..462cbf1a58 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -690,10 +690,17 @@ subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_na has_intrinsic_name = any([(index(module_name,trim(INTRINSIC_NAMES(j)))>0, & j=1,size(INTRINSIC_NAMES))]) if (intr>0 .and. .not.has_intrinsic_name) then - call file_parse_error(error,f_filename, & - 'module '//module_name//' is declared intrinsic but it is not ',i, & - lowercase) - return + + ! An intrinsic module was not found. Its name could be in the next line, + ! in which case, we just skip this check. The compiler will do the job if the name is invalid. + + ! Module name was not read: it's in the next line + if (index(module_name,'&')<=0) then + call file_parse_error(error,f_filename, & + 'module '//module_name//' is declared intrinsic but it is not ',i, & + lowercase) + return + endif endif ! Should we treat this as an intrinsic module From 44d2b3ce71826b608c24e77861ee98fa8dafafa8 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 1 Jun 2023 10:55:22 -0500 Subject: [PATCH 242/304] cleanup --- src/fpm_source_parsing.f90 | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 462cbf1a58..62719c7cb2 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -646,14 +646,10 @@ subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_na colons = index(lowercase,'::') nonintr = 0 intr = 0 - intrinsicness: if (colons>3) then - end if intrinsicness + have_colons: if (colons>3) then - ! If declared intrinsic, check that it is true - if (colons>3) then - - ! If there is an intrinsic/non-intrinsic spec + ! there may be an intrinsic/non-intrinsic spec nonintr = index(lowercase(1:colons-1),'non_intrinsic') if (nonintr==0) intr = index(lowercase(1:colons-1),'intrinsic') @@ -684,7 +680,7 @@ subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_na return end if - end if + end if have_colons ! If declared intrinsic, check that it is true has_intrinsic_name = any([(index(module_name,trim(INTRINSIC_NAMES(j)))>0, & From c966c6bcbc0a628454550650cca27ff9183ca019 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 2 Jun 2023 09:27:14 +0200 Subject: [PATCH 243/304] search `%MSMPI%` also in `get_mpi_runner` --- src/fpm_meta.f90 | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 388757ba8a..25f9a97196 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -838,6 +838,7 @@ subroutine get_mpi_runner(command,verbose,error) type(error_t), allocatable, intent(out) :: error character(*), parameter :: try(*) = ['mpiexec ','mpirun ','mpiexec.exe','mpirun.exe '] + character(:), allocatable :: bindir integer :: itri logical :: success @@ -855,6 +856,25 @@ subroutine get_mpi_runner(command,verbose,error) endif end do + ! On windows, also search in %MSMPI_BIN% + if (get_os_type()==OS_WINDOWS) then + ! Check that the runtime is installed + bindir = "" + call get_absolute_path(get_env('MSMPI_BIN'),bindir,error) + if (verbose) print *, '+ %MSMPI_BIN%=',bindir + ! In some environments, variable %MSMPI_BIN% is missing (i.e. in GitHub Action images). + ! Do a second attempt: search for the default location + if (len_trim(bindir)<=0 .or. allocated(error)) then + if (verbose) print *, '+ %MSMPI_BIN% empty, searching C:\Program Files\Microsoft MPI\Bin\ ...' + call get_absolute_path('C:\Program Files\Microsoft MPI\Bin\mpiexec.exe',bindir,error) + endif + if (len_trim(bindir)>0 .and. .not.allocated(error)) then + ! MSMPI_BIN directory found + command%s = join_path(bindir,'mpiexec.exe') + return + endif + endif + ! No valid command found call fatal_error(error,'cannot find a valid mpi runner command') return From c7c421a3098f25327060a9363f9ae1b1309df945 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 2 Jun 2023 05:41:49 -0500 Subject: [PATCH 244/304] Fpm release v0.9.0 (#922) * bump version to 0.9.0 * search MSMPI_BIN also in runner command * Update src/fpm_meta.f90 * Revert "search MSMPI_BIN also in runner command" This reverts commit 28d7e499d00b337dd6b7e457058b1fbb0733e179. --------- Co-authored-by: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> --- fpm.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm.toml b/fpm.toml index a2c8eeb3d6..90b1712f66 100644 --- a/fpm.toml +++ b/fpm.toml @@ -1,5 +1,5 @@ name = "fpm" -version = "0.8.2" +version = "0.9.0" license = "MIT" author = "fpm maintainers" maintainer = "" From a10bddb088af8a48ad3d95608af2cebd4b6133af Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 8 Jun 2023 09:28:17 +0200 Subject: [PATCH 245/304] allow overriding metapackages with standard deps --- src/fpm/manifest/dependency.f90 | 79 ++++++++++++++++++++++----------- src/fpm/manifest/meta.f90 | 38 +++++++++++++--- 2 files changed, 85 insertions(+), 32 deletions(-) diff --git a/src/fpm/manifest/dependency.f90 b/src/fpm/manifest/dependency.f90 index 4c4282500b..8d1b129fa9 100644 --- a/src/fpm/manifest/dependency.f90 +++ b/src/fpm/manifest/dependency.f90 @@ -29,7 +29,8 @@ module fpm_manifest_dependency use fpm_toml, only: toml_table, toml_key, toml_stat, get_value, check_keys use fpm_filesystem, only: windows_path, join_path use fpm_environment, only: get_os_type, OS_WINDOWS - use fpm_manifest_metapackages, only: metapackage_config_t, is_meta_package, new_meta_config + use fpm_manifest_metapackages, only: metapackage_config_t, is_meta_package, new_meta_config, & + metapackage_request_t, new_meta_request use fpm_versioning, only: version_t, new_version implicit none private @@ -223,46 +224,74 @@ subroutine new_dependencies(deps, table, root, meta, error) type(toml_table), pointer :: node type(toml_key), allocatable :: list(:) - logical, allocatable :: non_meta(:) + type(dependency_config_t), allocatable :: all_deps(:) + type(metapackage_request_t) :: meta_request + logical, allocatable :: is_meta(:) + logical :: metapackages_allowed integer :: idep, stat, ndep call table%get_keys(list) ! An empty table is okay if (size(list) < 1) return - !> Count non-metapackage dependencies, and parse metapackage config - if (present(meta)) then - ndep = 0 - do idep = 1, size(list) - if (is_meta_package(list(idep)%key)) cycle - ndep = ndep+1 - end do + !> Flag dependencies that should be treated as metapackages + metapackages_allowed = present(meta) + allocate(is_meta(size(list)),source=.false.) + allocate(all_deps(size(list))) - !> Return metapackages config from this node - call new_meta_config(meta, table, error) - if (allocated(error)) return - else - ndep = size(list) - end if - - ! Generate non-metapackage dependencies - allocate(deps(ndep)) - ndep = 0 + !> Parse all meta- and non-metapackage dependencies do idep = 1, size(list) - if (present(meta) .and. is_meta_package(list(idep)%key)) cycle - - ndep = ndep+1 - call get_value(table, list(idep)%key, node, stat=stat) if (stat /= toml_stat%success) then call syntax_error(error, "Dependency "//list(idep)%key//" must be a table entry") exit end if - call new_dependency(deps(ndep), node, root, error) - if (allocated(error)) exit + + ! Try to parse as a standard dependency + call new_dependency(all_deps(idep), node, root, error) + + is_standard_dependency: if (.not.allocated(error)) then + + ! If a valid git/local config is found, use it always + is_meta(idep) = .false. + + elseif (metapackages_allowed .and. is_meta_package(list(idep)%key)) then + + !> Metapackage name: Check if this is a valid metapackage request + call new_meta_request(meta_request, list(idep)%key, table, error=error) + + !> Neither a standard dep nor a metapackage + if (allocated(error)) return + + !> Valid meta dependency + is_meta(idep) = .true. + + else + + !> Not a standard dependency and not a metapackage: dump an error + call syntax_error(error, "Dependency "//list(idep)%key//" cannot be parsed. Check input format") + return + + endif is_standard_dependency + + end do + + ! Non-meta dependencies + ndep = count(.not.is_meta) + + ! Finalize standard dependencies + allocate(deps(ndep)) + ndep = 0 + do idep = 1, size(list) + if (is_meta(idep)) cycle + ndep = ndep+1 + deps(ndep) = all_deps(idep) end do + ! Finalize meta dependencies + if (metapackages_allowed) call new_meta_config(meta,table,is_meta,error) + end subroutine new_dependencies !> Write information on instance diff --git a/src/fpm/manifest/meta.f90 b/src/fpm/manifest/meta.f90 index 17261960eb..f4b3dadfa6 100644 --- a/src/fpm/manifest/meta.f90 +++ b/src/fpm/manifest/meta.f90 @@ -16,6 +16,7 @@ module fpm_manifest_metapackages private public :: metapackage_config_t, new_meta_config, is_meta_package + public :: metapackage_request_t, new_meta_request !> Configuration data for a single metapackage request @@ -95,7 +96,7 @@ subroutine request_parse(self, version_request, error) end subroutine request_parse !> Construct a new metapackage request from the dependencies table - subroutine new_request(self, key, table, error) + subroutine new_meta_request(self, key, table, meta_allowed, error) type(metapackage_request_t), intent(out) :: self @@ -105,12 +106,16 @@ subroutine new_request(self, key, table, error) !> Instance of the TOML data structure type(toml_table), intent(inout) :: table + !> List of keys allowed to be metapackages + logical, intent(in), optional :: meta_allowed(:) + !> Error handling type(error_t), allocatable, intent(out) :: error integer :: stat,i character(len=:), allocatable :: value + logical, allocatable :: allow_meta(:) type(toml_key), allocatable :: keys(:) call request_destroy(self) @@ -127,7 +132,23 @@ subroutine new_request(self, key, table, error) call table%get_keys(keys) + !> Set list of entries that are allowed to be metapackages + if (present(meta_allowed)) then + if (size(meta_allowed)/=size(keys)) then + call fatal_error(error,"Internal error: list of metapackage-enable entries does not match table size") + return + end if + allow_meta = meta_allowed + else + allocate(allow_meta(size(keys)),source=.true.) + endif + + do i=1,size(keys) + + ! Skip standard dependencies + if (.not.meta_allowed(i)) cycle + if (keys(i)%key==key) then call get_value(table, key, value) if (.not. allocated(value)) then @@ -143,10 +164,10 @@ subroutine new_request(self, key, table, error) ! Key is not present, metapackage not requested return - end subroutine new_request + end subroutine new_meta_request !> Construct a new build configuration from a TOML data structure - subroutine new_meta_config(self, table, error) + subroutine new_meta_config(self, table, meta_allowed, error) !> Instance of the build configuration type(metapackage_config_t), intent(out) :: self @@ -154,6 +175,9 @@ subroutine new_meta_config(self, table, error) !> Instance of the TOML data structure type(toml_table), intent(inout) :: table + !> List of keys allowed to be metapackages + logical, intent(in) :: meta_allowed(:) + !> Error handling type(error_t), allocatable, intent(out) :: error @@ -161,16 +185,16 @@ subroutine new_meta_config(self, table, error) !> The toml table is not checked here because it already passed !> the "new_dependencies" check - call new_request(self%openmp, "openmp", table, error) + call new_meta_request(self%openmp, "openmp", table, meta_allowed, error) if (allocated(error)) return - call new_request(self%stdlib, "stdlib", table, error) + call new_meta_request(self%stdlib, "stdlib", table, meta_allowed, error) if (allocated(error)) return - call new_request(self%minpack, "minpack", table, error) + call new_meta_request(self%minpack, "minpack", table, meta_allowed, error) if (allocated(error)) return - call new_request(self%mpi, "mpi", table, error) + call new_meta_request(self%mpi, "mpi", table, meta_allowed, error) if (allocated(error)) return end subroutine new_meta_config From f8c728278af48ad474afd7da883675977eb82fe8 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 8 Jun 2023 09:50:06 +0200 Subject: [PATCH 246/304] fix logic --- src/fpm/manifest/dependency.f90 | 33 +++++++++++++-------------------- src/fpm/manifest/meta.f90 | 2 +- 2 files changed, 14 insertions(+), 21 deletions(-) diff --git a/src/fpm/manifest/dependency.f90 b/src/fpm/manifest/dependency.f90 index 8d1b129fa9..75f5f5d10d 100644 --- a/src/fpm/manifest/dependency.f90 +++ b/src/fpm/manifest/dependency.f90 @@ -242,38 +242,31 @@ subroutine new_dependencies(deps, table, root, meta, error) !> Parse all meta- and non-metapackage dependencies do idep = 1, size(list) + ! Check if this is a standard dependency node call get_value(table, list(idep)%key, node, stat=stat) - if (stat /= toml_stat%success) then - call syntax_error(error, "Dependency "//list(idep)%key//" must be a table entry") - exit - end if - - ! Try to parse as a standard dependency - call new_dependency(all_deps(idep), node, root, error) - - is_standard_dependency: if (.not.allocated(error)) then - - ! If a valid git/local config is found, use it always - is_meta(idep) = .false. + is_standard_dependency: if (stat /= toml_stat%success) then - elseif (metapackages_allowed .and. is_meta_package(list(idep)%key)) then - - !> Metapackage name: Check if this is a valid metapackage request + ! See if it can be a valid metapackage name call new_meta_request(meta_request, list(idep)%key, table, error=error) !> Neither a standard dep nor a metapackage - if (allocated(error)) return + if (allocated(error)) then + call syntax_error(error, "Dependency "//list(idep)%key//" is not a valid metapackage or a table entry") + return + endif !> Valid meta dependency is_meta(idep) = .true. else - !> Not a standard dependency and not a metapackage: dump an error - call syntax_error(error, "Dependency "//list(idep)%key//" cannot be parsed. Check input format") - return + ! Parse as a standard dependency + is_meta(idep) = .false. + + call new_dependency(all_deps(idep), node, root, error) + if (allocated(error)) return - endif is_standard_dependency + end if is_standard_dependency end do diff --git a/src/fpm/manifest/meta.f90 b/src/fpm/manifest/meta.f90 index f4b3dadfa6..3719067030 100644 --- a/src/fpm/manifest/meta.f90 +++ b/src/fpm/manifest/meta.f90 @@ -147,7 +147,7 @@ subroutine new_meta_request(self, key, table, meta_allowed, error) do i=1,size(keys) ! Skip standard dependencies - if (.not.meta_allowed(i)) cycle + if (.not.allow_meta(i)) cycle if (keys(i)%key==key) then call get_value(table, key, value) From 9a46ce4e52d6805ec9f9f39885f114b1faa09b79 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 8 Jun 2023 10:20:21 +0200 Subject: [PATCH 247/304] add metapackage overriding tests --- test/fpm_test/test_package_dependencies.f90 | 69 ++++++++++++++++++++- 1 file changed, 68 insertions(+), 1 deletion(-) diff --git a/test/fpm_test/test_package_dependencies.f90 b/test/fpm_test/test_package_dependencies.f90 index 75a1cb255c..4f645750b5 100644 --- a/test/fpm_test/test_package_dependencies.f90 +++ b/test/fpm_test/test_package_dependencies.f90 @@ -7,6 +7,8 @@ module test_package_dependencies use fpm_os, only: get_current_directory use fpm_dependency use fpm_manifest_dependency + use fpm_manifest_metapackages, only: metapackage_config_t + use fpm_manifest, only: package_config_t, get_package_data use fpm_toml use fpm_settings, only: fpm_global_settings, get_registry_settings, get_global_settings use fpm_downloader, only: downloader_t @@ -45,10 +47,11 @@ subroutine collect_package_dependencies(tests) & new_unittest("status-after-load", test_status), & & new_unittest("add-dependencies", test_add_dependencies), & & new_unittest("update-dependencies", test_update_dependencies), & + & new_unittest("metapackage-override", test_metapackage_override), & & new_unittest("do-not-update-dependencies", test_non_updated_dependencies), & & new_unittest("registry-dir-not-found", registry_dir_not_found, should_fail=.true.), & & new_unittest("no-versions-in-registry", no_versions_in_registry, should_fail=.true.), & - & new_unittest("local-registry-specified-version-not-found", local_registry_specified_version_not_found, should_fail=.true.), & + & new_unittest("local-registry-specified-version-not-found", local_registry_specified_version_not_found, should_fail=.true.), & & new_unittest("local-registry-specified-no-manifest", local_registry_specified_no_manifest, should_fail=.true.), & & new_unittest("local-registry-specified-has-manifest", local_registry_specified_has_manifest), & & new_unittest("local-registry-specified-not-a-dir", local_registry_specified_not_a_dir, should_fail=.true.), & @@ -421,6 +424,70 @@ subroutine test_update_dependencies(error) end subroutine test_update_dependencies + + !> Test that a metapackage is overridden if a regular dependency is provided + subroutine test_metapackage_override(error) + + !> Error handling + type(error_t), allocatable, intent(out) :: error + + type(toml_table) :: manifest + type(toml_table), pointer :: ptr + type(dependency_config_t), allocatable :: deps(:) + type(metapackage_config_t) :: meta + logical :: found + integer :: i + + ! Create a dummy manifest, with a standard git dependency for stdlib + manifest = toml_table() + call add_table(manifest, "stdlib", ptr) + call set_value(ptr, "git", "https://github.com/fortran-lang/stdlib") + call set_value(ptr, "branch", "stdlib-fpm") + + ! Load dependencies from manifest + call new_dependencies(deps, manifest, meta=meta, error=error) + if (allocated(error)) return + + ! Check that stdlib is in the regular dependency list + found = .false. + do i=1,size(deps) + if (deps(i)%name=="stdlib") found = .true. + end do + + if (.not.found) then + call test_failed(error,"standard git-based dependency for stdlib not recognized") + return + end if + call manifest%destroy() + + + ! Create a dummy manifest, with a version-based metapackage dependency for stdlib + manifest = toml_table() + call set_value(manifest, "stdlib", "*") + + ! Load dependencies from manifest + call new_dependencies(deps, manifest, meta=meta, error=error) + if (allocated(error)) return + + ! Check that stdlib is in the metapackage config and not the standard dependencies + found = .false. + do i=1,size(deps) + if (deps(i)%name=="stdlib") found = .true. + end do + + if (found) then + call test_failed(error,"metapackage dependency for stdlib should not be in the tree") + return + end if + call manifest%destroy() + + if (.not.meta%stdlib%on) then + call test_failed(error,"metapackage dependency for stdlib should be in the metapackage config") + return + end if + + end subroutine test_metapackage_override + !> Directories for namespace and package name not found in path registry. subroutine registry_dir_not_found(error) type(error_t), allocatable, intent(out) :: error From c80cdfda1edfd96a6e339a966baf01c7a5743095 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Thu, 8 Jun 2023 10:32:17 +0200 Subject: [PATCH 248/304] add `mpi` and `mpi_f08` to the list of external modules --- src/fpm_meta.f90 | 51 +++++++++++++++++++++++++++++------------------- 1 file changed, 31 insertions(+), 20 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 25f9a97196..c8fd4171de 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -39,15 +39,16 @@ module fpm_meta !> Package version (if supported) type(version_t), allocatable :: version - logical :: has_link_libraries = .false. - logical :: has_link_flags = .false. - logical :: has_build_flags = .false. - logical :: has_fortran_flags = .false. - logical :: has_c_flags = .false. - logical :: has_cxx_flags = .false. - logical :: has_include_dirs = .false. - logical :: has_dependencies = .false. - logical :: has_run_command = .false. + logical :: has_link_libraries = .false. + logical :: has_link_flags = .false. + logical :: has_build_flags = .false. + logical :: has_fortran_flags = .false. + logical :: has_c_flags = .false. + logical :: has_cxx_flags = .false. + logical :: has_include_dirs = .false. + logical :: has_dependencies = .false. + logical :: has_run_command = .false. + logical :: has_external_modules = .false. !> List of compiler flags and options to be added type(string_t) :: flags @@ -58,6 +59,7 @@ module fpm_meta type(string_t) :: run_command type(string_t), allocatable :: incl_dirs(:) type(string_t), allocatable :: link_libs(:) + type(string_t), allocatable :: external_modules(:) !> Special fortran features type(fortran_features_t), allocatable :: fortran @@ -120,15 +122,16 @@ end function MPI_TYPE_NAME elemental subroutine destroy(this) class(metapackage_t), intent(inout) :: this - this%has_link_libraries = .false. - this%has_link_flags = .false. - this%has_build_flags = .false. - this%has_fortran_flags = .false. - this%has_c_flags = .false. - this%has_cxx_flags = .false. - this%has_include_dirs = .false. - this%has_dependencies = .false. - this%has_run_command = .false. + this%has_link_libraries = .false. + this%has_link_flags = .false. + this%has_build_flags = .false. + this%has_fortran_flags = .false. + this%has_c_flags = .false. + this%has_cxx_flags = .false. + this%has_include_dirs = .false. + this%has_dependencies = .false. + this%has_run_command = .false. + this%has_external_modules = .false. if (allocated(this%fortran)) deallocate(this%fortran) if (allocated(this%version)) deallocate(this%version) @@ -141,6 +144,7 @@ elemental subroutine destroy(this) if (allocated(this%link_libs)) deallocate(this%link_libs) if (allocated(this%dependency)) deallocate(this%dependency) if (allocated(this%incl_dirs)) deallocate(this%incl_dirs) + if (allocated(this%external_modules)) deallocate(this%external_modules) end subroutine destroy @@ -327,6 +331,10 @@ subroutine resolve_model(self,model,error) model%include_dirs = [model%include_dirs,self%incl_dirs] end if + if (self%has_external_modules) then + model%external_modules = [model%external_modules,self%external_modules] + end if + end subroutine resolve_model subroutine resolve_package_config(self,package,error) @@ -467,11 +475,9 @@ subroutine init_mpi(this,compiler,error) integer :: wcfit(3),mpilib(3),ic,icpp,i logical :: found - !> Cleanup call destroy(this) - !> Get all candidate MPI wrappers call mpi_wrappers(compiler,fort_wrappers,c_wrappers,cpp_wrappers) if (verbose) print 1, size(fort_wrappers),size(c_wrappers),size(cpp_wrappers) @@ -522,6 +528,11 @@ subroutine init_mpi(this,compiler,error) end if + !> Not all MPI implementations offer modules mpi and mpi_f08: hence, include them + !> to the list of external modules, so they won't be requested as standard source files + this%has_external_modules = .true. + this%external_modules = [string_t("mpi"),string_t("mpi_f08")] + 1 format('MPI wrappers found: fortran=',i0,' c=',i0,' c++=',i0) end subroutine init_mpi From e5a45626c146d8972ed819c75bb9d69c2c2a1b83 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 9 Jun 2023 21:24:13 +0700 Subject: [PATCH 249/304] Fix typo --- src/fpm/cmd/publish.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index 22c283dac8..c92cc5ff14 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -47,7 +47,7 @@ subroutine cmd_publish(settings) !> Checks before uploading the package. if (.not. allocated(package%license)) call fpm_stop(1, 'No license specified in fpm.toml.') if (.not. package%build%module_naming) call fpm_stop(1, 'The package does not meet the module naming requirements. '// & - & 'Please set "module_naming = true" in fpm.toml [build] or specify a custom module prefix.') + & 'Please set "module-naming = true" in fpm.toml [build] or specify a custom module prefix.') if (.not. allocated(version)) call fpm_stop(1, 'No version specified in fpm.toml.') if (version%s() == '0') call fpm_stop(1, 'Invalid version: "'//version%s()//'".') if (.not. exists('fpm.toml')) call fpm_stop(1, "Cannot find 'fpm.toml' file. Are you in the project root?") From 1075f02ec7c85e0b6af157c512550f754ae117e4 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Fri, 9 Jun 2023 23:55:59 -0400 Subject: [PATCH 250/304] document run(3f) and markdown errata --- src/fpm_filesystem.F90 | 83 +++++++++++++++++++++++++++++++++++------- src/fpm_strings.f90 | 18 ++++----- 2 files changed, 77 insertions(+), 24 deletions(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 97feb1801b..d5637357d1 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -774,31 +774,32 @@ subroutine filewrite(filename,filedata) end subroutine filewrite -function which(command) result(pathname) +!>AUTHOR: John S. Urban +!!LICENSE: Public Domain !> -!!##NAME +!!##Name !! which(3f) - [M_io:ENVIRONMENT] given a command name find the pathname by searching !! the directories in the environment variable $PATH !! (LICENSE:PD) !! -!!##SYNTAX +!!##Syntax !! function which(command) result(pathname) !! !! character(len=*),intent(in) :: command !! character(len=:),allocatable :: pathname !! -!!##DESCRIPTION +!!##Description !! Given a command name find the first file with that name in the directories !! specified by the environment variable $PATH. !! -!!##OPTIONS +!!##options !! COMMAND the command to search for !! -!!##RETURNS +!!##Returns !! PATHNAME the first pathname found in the current user path. Returns blank !! if the command is not found. !! -!!##EXAMPLE +!!##Example !! !! Sample program: !! @@ -812,11 +813,7 @@ function which(command) result(pathname) !! write(*,*)'install is ',which('install') !! end program demo_which !! -!!##AUTHOR -!! John S. Urban -!!##LICENSE -!! Public Domain - +function which(command) result(pathname) character(len=*),intent(in) :: command character(len=:),allocatable :: pathname, checkon, paths(:), exts(:) integer :: i, j @@ -854,8 +851,66 @@ function which(command) result(pathname) enddo SEARCH end function which -!> echo command string and pass it to the system for execution -!call run(cmd,echo=.false.,exitstat=exitstat,verbose=.false.,redirect='') +!>AUTHOR: fpm(1) contributors +!!LICENSE: MIT +!> +!!##Name +!! run(3f) - execute specified system command and selectively echo +!! command and output to a file and/or stdout. +!! (LICENSE:MIT) +!! +!!##Syntax +!! subroutine run(cmd,echo,exitstat,verbose,redirect) +!! +!! character(len=*), intent(in) :: cmd +!! logical,intent(in),optional :: echo +!! integer, intent(out),optional :: exitstat +!! logical, intent(in), optional :: verbose +!! character(*), intent(in), optional :: redirect +!! +!!##Description +!! Execute the specified system command. Optionally +!! +!! + echo the command before execution +!! + return the system exit status of the command. +!! + redirect the output of the command to a file. +!! + echo command output to stdout +!! +!! Calling run(3f) is preferred to direct calls to +!! execute_command_line(3f) in the fpm(1) source to provide a standard +!! interface where output modes can be specified. +!! +!!##Options +!! CMD System command to execute +!! ECHO Whether to echo the command being executed or not +!! Defaults to .TRUE. . +!! VERBOSE Whether to redirect the command output to a null device or not +!! Defaults to .TRUE. . +!! REDIRECT Filename to redirect stdout and stderr of the command into. +!! If generated it is closed before run(3f) returns. +!! EXITSTAT The system exit status of the command when supported by +!! the system. If not present and a non-zero status is +!! generated program termination occurs. +!! +!!##Example +!! +!! Sample program: +!! +!! Checking the error message and counting lines: +!! +!! program demo_run +!! use fpm_filesystem, only : run +!! implicit none +!! logical,parameter :: T=.true., F=.false. +!! integer :: exitstat +!! character(len=:),allocatable :: cmd +!! cmd='ls -ltrasd *.md' +!! call run(cmd) +!! call run(cmd,exitstat=exitstat) +!! call run(cmd,echo=F) +!! call run(cmd,verbose=F) +!! end program demo_run +!! subroutine run(cmd,echo,exitstat,verbose,redirect) character(len=*), intent(in) :: cmd logical,intent(in),optional :: echo diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index 404a7dc6f5..e478f4dba6 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -236,9 +236,9 @@ pure function fnv_1a_string_t(input, seed) result(hash) end function fnv_1a_string_t - !>Author: John S. Urban - !!License: Public Domain - !! Changes a string to lowercase over optional specified column range +!>Author: John S. Urban +!!License: Public Domain +!! Changes a string to lowercase over optional specified column range elemental pure function lower(str,begin,end) result (string) character(*), intent(In) :: str @@ -624,8 +624,9 @@ pure function join(str,sep,trm,left,right,start,end) result (string) if(present(end))string=string//end end function join -!>##AUTHOR John S. Urban -!!##LICENSE Public Domain +!>AUTHOR: John S. Urban +!!LICENSE: Public Domain +!> !!## NAME !! glob(3f) - [fpm_strings:COMPARE] compare given string for match to !! pattern which may contain wildcard characters @@ -1259,6 +1260,8 @@ subroutine remove_newline_characters(string) end subroutine remove_newline_characters +!>AUTHOR: John S. Urban +!!LICENSE: Public Domain !> !!### NAME !! notabs(3f) - [fpm_strings:NONALPHA] expand tab characters @@ -1316,11 +1319,6 @@ end subroutine remove_newline_characters !!### SEE ALSO !! GNU/Unix commands expand(1) and unexpand(1) !! -!!### AUTHOR -!! John S. Urban -!! -!!### LICENSE -!! Public Domain elemental impure subroutine notabs(instr,outstr,ilen) ! ident_31="@(#)fpm_strings::notabs(3f): convert tabs to spaces while maintaining columns, remove CRLF chars" From 2ada9fae44a8ed62cde35c636f79dbb81f2fa282 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sat, 10 Jun 2023 00:00:23 -0400 Subject: [PATCH 251/304] start example directory --- example/demo_run.f90 | 47 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 example/demo_run.f90 diff --git a/example/demo_run.f90 b/example/demo_run.f90 new file mode 100644 index 0000000000..c22a145000 --- /dev/null +++ b/example/demo_run.f90 @@ -0,0 +1,47 @@ +program demo_run +use fpm_filesystem, only: run +implicit none +integer :: exitstat +character(len=:), allocatable :: cmd +logical, parameter T = .true., F = .false. +cmd = 'ls -ltrasd *.md' + + call run(cmd) + call paws('default options (ie. echo=T verbose=T)') + + call run(cmd, exitstat=exitstat) + write (*, *) 'exitstat=', exitstat + call paws('exitstat') + + call run(cmd, echo=F) + call paws('echo=F') + + call run(cmd, verbose=F) + call paws('verbose=F') + + call run(cmd, verbose=F, echo=F) + call paws('verbose=F echo=F') + + call run(cmd, redirect='_scratch') + call paws('redirect="_scratch"') + + call run(cmd, redirect='_scratch', verbose=F) + call paws('redirect="_scratch" verbose=F') + + call run(cmd, redirect='_scratch', verbose=T) + call paws('redirect="_scratch" verbose=T') + +contains + +subroutine paws(str) +character(len=*), intent(in) :: str +character(len=1) :: chr +integer :: iostat + + write (*, '(a,": ")', advance='no') str + read (*, '(a)', iostat=iostat) chr + write (*, '(a)') repeat('-', 60) + +end subroutine paws + +end program demo_run From 69edccf1ffb69186e077953dc57dd38b9694b52f Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sat, 10 Jun 2023 00:20:40 -0400 Subject: [PATCH 252/304] correct example --- example/demo_run.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/example/demo_run.f90 b/example/demo_run.f90 index c22a145000..90bebb9e32 100644 --- a/example/demo_run.f90 +++ b/example/demo_run.f90 @@ -3,7 +3,7 @@ program demo_run implicit none integer :: exitstat character(len=:), allocatable :: cmd -logical, parameter T = .true., F = .false. +logical, parameter :: T = .true., F = .false. cmd = 'ls -ltrasd *.md' call run(cmd) From 98eb02134fa42dedccd4404817bbb11464151268 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Sat, 10 Jun 2023 00:30:05 -0400 Subject: [PATCH 253/304] remove example/ --- example/demo_run.f90 | 47 -------------------------------------------- 1 file changed, 47 deletions(-) delete mode 100644 example/demo_run.f90 diff --git a/example/demo_run.f90 b/example/demo_run.f90 deleted file mode 100644 index 90bebb9e32..0000000000 --- a/example/demo_run.f90 +++ /dev/null @@ -1,47 +0,0 @@ -program demo_run -use fpm_filesystem, only: run -implicit none -integer :: exitstat -character(len=:), allocatable :: cmd -logical, parameter :: T = .true., F = .false. -cmd = 'ls -ltrasd *.md' - - call run(cmd) - call paws('default options (ie. echo=T verbose=T)') - - call run(cmd, exitstat=exitstat) - write (*, *) 'exitstat=', exitstat - call paws('exitstat') - - call run(cmd, echo=F) - call paws('echo=F') - - call run(cmd, verbose=F) - call paws('verbose=F') - - call run(cmd, verbose=F, echo=F) - call paws('verbose=F echo=F') - - call run(cmd, redirect='_scratch') - call paws('redirect="_scratch"') - - call run(cmd, redirect='_scratch', verbose=F) - call paws('redirect="_scratch" verbose=F') - - call run(cmd, redirect='_scratch', verbose=T) - call paws('redirect="_scratch" verbose=T') - -contains - -subroutine paws(str) -character(len=*), intent(in) :: str -character(len=1) :: chr -integer :: iostat - - write (*, '(a,": ")', advance='no') str - read (*, '(a)', iostat=iostat) chr - write (*, '(a)') repeat('-', 60) - -end subroutine paws - -end program demo_run From 3c0bbcb5374b5587f02b7e9528f7d1c8904ec2d4 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 11 Jun 2023 11:53:23 +0200 Subject: [PATCH 254/304] do not preprocess with `trim(adjustl(line))` --- src/fpm_source_parsing.f90 | 38 +++++++++++++++++++++++--------------- 1 file changed, 23 insertions(+), 15 deletions(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index 62719c7cb2..ed5746c90d 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -615,8 +615,13 @@ end function parse_sequence ! USE [, intrinsic] :: module_name [, only: only_list] ! USE [, non_intrinsic] :: module_name [, only: only_list] subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_name,error) - character(*), intent(in) :: f_filename,line - integer, intent(in) :: i ! line number + + !> Current file name and line number (for error messaging) + character(*), intent(in) :: f_filename + integer, intent(in) :: i + + !> The line being parsed. MUST BE preprocessed with trim(adjustl() + character(*), intent(in) :: line logical, intent(out) :: use_stmt,is_intrinsic character(:), allocatable, intent(out) :: module_name type(error_t), allocatable, intent(out) :: error @@ -629,7 +634,7 @@ subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_na 'ieee_features ', & 'omp_lib '] - character(len=:), allocatable :: lowercase,temp_string + character(len=:), allocatable :: temp_string integer :: colons,intr,nonintr,j,stat logical :: has_intrinsic_name @@ -637,28 +642,31 @@ subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_na is_intrinsic = .false. if (len_trim(line)<=0) return - ! Preprocess: lowercase, remove heading spaces - lowercase = lower(trim(adjustl(line))) + ! Quick check that the line is preprocessed + if (line(1:1)==' ') then + call fatal_error(error,'internal_error: source file line is not trim(adjustl()) on input to parse_use_statement') + return + end if ! 'use' should be the first string in the adjustl line - use_stmt = index(lowercase,'use ')==1 .or. index(lowercase,'use::')==1 .or. index(lowercase,'use,')==1 + use_stmt = index(line,'use ')==1 .or. index(line,'use::')==1 .or. index(line,'use,')==1 if (.not.use_stmt) return - colons = index(lowercase,'::') + colons = index(line,'::') nonintr = 0 intr = 0 have_colons: if (colons>3) then ! there may be an intrinsic/non-intrinsic spec - nonintr = index(lowercase(1:colons-1),'non_intrinsic') - if (nonintr==0) intr = index(lowercase(1:colons-1),'intrinsic') + nonintr = index(line(1:colons-1),'non_intrinsic') + if (nonintr==0) intr = index(line(1:colons-1),'intrinsic') - temp_string = split_n(lowercase,delims=':',n=2,stat=stat) + temp_string = split_n(line,delims=':',n=2,stat=stat) if (stat /= 0) then call file_parse_error(error,f_filename, & 'unable to find used module name',i, & - lowercase,colons) + line,colons) return end if @@ -666,17 +674,17 @@ subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_na if (stat /= 0) then call file_parse_error(error,f_filename, & 'unable to find used module name',i, & - lowercase) + line) return end if else - module_name = split_n(lowercase,n=2,delims=' ,',stat=stat) + module_name = split_n(line,n=2,delims=' ,',stat=stat) if (stat /= 0) then call file_parse_error(error,f_filename, & 'unable to find used module name',i, & - lowercase) + line) return end if @@ -694,7 +702,7 @@ subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_na if (index(module_name,'&')<=0) then call file_parse_error(error,f_filename, & 'module '//module_name//' is declared intrinsic but it is not ',i, & - lowercase) + line) return endif endif From af077f2f81f67f6710242d188361dca9240eecfc Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 11 Jun 2023 11:58:00 +0200 Subject: [PATCH 255/304] document arguments --- src/fpm_source_parsing.f90 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index ed5746c90d..f303a1c2cf 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -622,8 +622,17 @@ subroutine parse_use_statement(f_filename,i,line,use_stmt,is_intrinsic,module_na !> The line being parsed. MUST BE preprocessed with trim(adjustl() character(*), intent(in) :: line - logical, intent(out) :: use_stmt,is_intrinsic + + !> Does this line contain a `use` statement? + logical, intent(out) :: use_stmt + + !> Is the module in this statement intrinsic? + logical, intent(out) :: is_intrinsic + + !> used module name character(:), allocatable, intent(out) :: module_name + + !> Error handling type(error_t), allocatable, intent(out) :: error character(15), parameter :: INTRINSIC_NAMES(*) = & From 6e3ca2b3fcac1f7aebf8d83b1dc4208d57ec980a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 11 Jun 2023 12:01:02 +0200 Subject: [PATCH 256/304] fix error messages in test --- test/fpm_test/test_source_parsing.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test/fpm_test/test_source_parsing.f90 b/test/fpm_test/test_source_parsing.f90 index 41d7db3a84..9a5f5802ec 100644 --- a/test/fpm_test/test_source_parsing.f90 +++ b/test/fpm_test/test_source_parsing.f90 @@ -240,22 +240,22 @@ subroutine test_nonintrinsic_modules_used(error) end if if (.not. ('ieee_arithmetic' .in. f_source%modules_used)) then - call test_failed(error,'Non-Intrinsic module found in modules_used') + call test_failed(error,'Non-Intrinsic module not found in modules_used') return end if if (.not. ('ieee_exceptions' .in. f_source%modules_used)) then - call test_failed(error,'Non-Intrinsic module found in modules_used') + call test_failed(error,'Non-Intrinsic module not found in modules_used') return end if if (.not. ('ieee_features' .in. f_source%modules_used)) then - call test_failed(error,'Non-Intrinsic module found in modules_used') + call test_failed(error,'Non-Intrinsic module not found in modules_used') return end if if (.not. ('my_module' .in. f_source%modules_used)) then - call test_failed(error,'Non-Intrinsic module found in modules_used') + call test_failed(error,'Non-Intrinsic module not found in modules_used') return end if From fde7e7cdc8fe6e6c825ca3595b639eefcb38282f Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 14 Jun 2023 14:28:26 +0200 Subject: [PATCH 257/304] MPI: check run command only on `run` and `test` apps --- src/fpm_meta.f90 | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index c8fd4171de..153a798f23 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -412,6 +412,15 @@ subroutine add_metapackage_model(model,package,settings,name,error) call meta%resolve(settings,error) if (allocated(error)) return + ! If we need to run executables, there shouold be an MPI runner + if (name=="mpi") then + select type (settings) + class is (fpm_run_settings) ! run, test + if (.not.meta%has_run_command) & + call fatal_error(error,"cannot find a valid mpi runner on the local host") + end select + endif + end subroutine add_metapackage_model !> Resolve all metapackages into the package config @@ -1006,8 +1015,10 @@ subroutine init_mpi_from_wrappers(this,compiler,mpilib,fort_wrapper,c_wrapper,cx !> Add default run command, if present this%run_command = mpi_wrapper_query(mpilib,fort_wrapper,'runner',verbose,error) - if (allocated(error)) return - this%has_run_command = len_trim(this%run_command)>0 + this%has_run_command = (len_trim(this%run_command)>0) .and. .not.allocated(error) + + !> Do not trigger a fatal error here if run command is missing + if (allocated(error)) deallocate(error) contains From 08dbd956341c40518572b331d72dd98f16a79eb6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 14 Jun 2023 14:54:00 +0200 Subject: [PATCH 258/304] fix invalid verbosity --- src/fpm_meta.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 153a798f23..e3cb5cbcfb 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -864,7 +864,7 @@ subroutine get_mpi_runner(command,verbose,error) ! Try several commands do itri=1,size(try) - call find_command_location(trim(try(itri)),command%s,verbose=.true.,error=error) + call find_command_location(trim(try(itri)),command%s,verbose=verbose,error=error) if (allocated(error)) cycle ! Success! From 0c68c3670b58c046948bee9f74c449301eb73578 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 14 Jun 2023 15:06:24 +0200 Subject: [PATCH 259/304] remove verbosity --- src/fpm_meta.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index e3cb5cbcfb..1ddf969693 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1074,7 +1074,7 @@ subroutine mpi_compiler_match(language,wrappers,compiler,which_one,mpilib,error) select case (language) case (LANG_FORTRAN) ! Build compiler type. The ID is created based on the Fortran name - call new_compiler(mpi_compiler,screen%s,'','',echo=.true.,verbose=.true.) + call new_compiler(mpi_compiler,screen%s,'','',echo=.true.,verbose=.false.) ! Fortran match found! if (mpi_compiler%id == compiler%id) then From 535f5ffe17c7aa64819bac0a3f88b687be931c86 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 14 Jun 2023 09:15:13 -0500 Subject: [PATCH 260/304] Update src/fpm_meta.f90 Co-authored-by: Minh Dao <43783196+minhqdao@users.noreply.github.com> --- src/fpm_meta.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 1ddf969693..fa113f0c7a 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -412,7 +412,7 @@ subroutine add_metapackage_model(model,package,settings,name,error) call meta%resolve(settings,error) if (allocated(error)) return - ! If we need to run executables, there shouold be an MPI runner + ! If we need to run executables, there should be an MPI runner if (name=="mpi") then select type (settings) class is (fpm_run_settings) ! run, test From 0e5ad5ca3a7eb9dcdf58fed3db2ae041e1dbf009 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 14 Jun 2023 22:01:21 +0200 Subject: [PATCH 261/304] do not use `error` for mpi runner search --- src/fpm_meta.f90 | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 1ddf969693..d0cb3a7737 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -976,6 +976,7 @@ subroutine init_mpi_from_wrappers(this,compiler,mpilib,fort_wrapper,c_wrapper,cx type(error_t), allocatable, intent(out) :: error type(version_t) :: version + type(error_t), allocatable :: runner_error ! Cleanup structure call destroy(this) @@ -1014,11 +1015,8 @@ subroutine init_mpi_from_wrappers(this,compiler,mpilib,fort_wrapper,c_wrapper,cx end if !> Add default run command, if present - this%run_command = mpi_wrapper_query(mpilib,fort_wrapper,'runner',verbose,error) - this%has_run_command = (len_trim(this%run_command)>0) .and. .not.allocated(error) - - !> Do not trigger a fatal error here if run command is missing - if (allocated(error)) deallocate(error) + this%run_command = mpi_wrapper_query(mpilib,fort_wrapper,'runner',verbose,runner_error) + this%has_run_command = (len_trim(this%run_command)>0) .and. .not.allocated(runner_error) contains From 83d0c4ab6cf2e8487f8a89d72f9daf528accd49d Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Jun 2023 14:45:18 +0700 Subject: [PATCH 262/304] Add verbose output to git_archive --- src/fpm/cmd/publish.f90 | 3 +-- src/fpm/git.f90 | 28 ++++++++++++++++++++++++---- 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index c92cc5ff14..121316e7b4 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -65,7 +65,7 @@ subroutine cmd_publish(settings) end do tmp_file = get_temp_filename() - call git_archive('.', tmp_file, error) + call git_archive('.', tmp_file, 'HEAD', settings%verbose, error) if (allocated(error)) call fpm_stop(1, '*cmd_publish* Archive error: '//error%message) upload_data = [ & @@ -91,7 +91,6 @@ subroutine cmd_publish(settings) end if if (settings%verbose) then - print *, '' call print_upload_data(upload_data) print *, '' end if diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index ad86ca3f73..f8238b2075 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -308,31 +308,51 @@ subroutine info(self, unit, verbosity) end subroutine info !> Archive a folder using `git archive`. - subroutine git_archive(source, destination, error) + subroutine git_archive(source, destination, ref, verbose, error) !> Directory to archive. character(*), intent(in) :: source !> Destination of the archive. character(*), intent(in) :: destination + !> (Symbolic) Reference to be archived. + character(*), intent(in) :: ref + !> Whether to print verbose output. + logical, intent(in) :: verbose !> Error handling. type(error_t), allocatable, intent(out) :: error integer :: stat - character(len=:), allocatable :: cmd_output, archive_format + character(len=:), allocatable :: cmd_output, archive_format, cmd + + if (verbose) then + print *, '' + print *, 'Show git archive options:' + print *, ' + git archive -l' + end if call execute_and_read_output('git archive -l', cmd_output, error) if (allocated(error)) return + if (verbose) print *, ' ', cmd_output + if (index(cmd_output, 'tar.gz') /= 0) then archive_format = 'tar.gz' else 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 '//destination, exitstat=stat) + cmd = 'git archive '//ref//' --format='//archive_format//' -o '//destination + + if (verbose) then + print *, '' + print *, 'Archive ', ref, ' using ', archive_format, ':' + print *, ' + ', cmd + print *, '' + end if + + call execute_command_line(cmd, exitstat=stat) if (stat /= 0) then call fatal_error(error, "Error packing '"//source//"'."); return end if end - end module fpm_git From c983e484ff059b6076d20c04709f93c276ff5de6 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Jun 2023 15:14:47 +0700 Subject: [PATCH 263/304] Add verbose printout to package upload --- src/fpm/cmd/publish.f90 | 2 +- src/fpm/downloader.f90 | 18 ++++++++++++++---- src/fpm/git.f90 | 2 +- 3 files changed, 16 insertions(+), 6 deletions(-) diff --git a/src/fpm/cmd/publish.f90 b/src/fpm/cmd/publish.f90 index 121316e7b4..43636c0e30 100644 --- a/src/fpm/cmd/publish.f90 +++ b/src/fpm/cmd/publish.f90 @@ -101,7 +101,7 @@ subroutine cmd_publish(settings) print *, 'Dry run successful. Generated tarball: ', tmp_file; return end if - call downloader%upload_form(official_registry_base_url//'/packages', upload_data, error) + call downloader%upload_form(official_registry_base_url//'/packages', upload_data, settings%verbose, error) call delete_file(tmp_file) if (allocated(error)) call fpm_stop(1, '*cmd_publish* Upload error: '//error%message) end diff --git a/src/fpm/downloader.f90 b/src/fpm/downloader.f90 index 7c5046df4e..b557d3ded6 100644 --- a/src/fpm/downloader.f90 +++ b/src/fpm/downloader.f90 @@ -76,23 +76,30 @@ subroutine get_file(url, tmp_pkg_file, error) end !> Perform an http post request with form data. - subroutine upload_form(endpoint, form_data, error) + subroutine upload_form(endpoint, form_data, verbose, error) + !> Endpoint to upload to. character(len=*), intent(in) :: endpoint + !> Form data to upload. type(string_t), intent(in) :: form_data(:) + !> Print additional information when true. + logical, intent(in) :: verbose + !> Error handling. type(error_t), allocatable, intent(out) :: error integer :: stat, i - character(len=:), allocatable :: form_data_str + character(len=:), allocatable :: form_data_str, cmd form_data_str = '' do i = 1, size(form_data) form_data_str = form_data_str//"-F '"//form_data(i)%s//"' " end do + cmd = 'curl -X POST -H "Content-Type: multipart/form-data" '//form_data_str//endpoint + if (which('curl') /= '') then print *, 'Uploading package ...' - call execute_command_line('curl -X POST -H "Content-Type: multipart/form-data" ' & - & //form_data_str//endpoint, exitstat=stat) + if (verbose) print *, ' + ', cmd + call execute_command_line(cmd, exitstat=stat) else call fatal_error(error, "'curl' not installed."); return end if @@ -104,8 +111,11 @@ subroutine upload_form(endpoint, form_data, error) !> Unpack a tarball to a destination. subroutine unpack(tmp_pkg_file, destination, error) + !> Path to tarball. character(*), intent(in) :: tmp_pkg_file + !> Destination to unpack to. character(*), intent(in) :: destination + !> Error handling. type(error_t), allocatable, intent(out) :: error integer :: stat diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index f8238b2075..b053427583 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -315,7 +315,7 @@ subroutine git_archive(source, destination, ref, verbose, error) character(*), intent(in) :: destination !> (Symbolic) Reference to be archived. character(*), intent(in) :: ref - !> Whether to print verbose output. + !> Print additional information when true. logical, intent(in) :: verbose !> Error handling. type(error_t), allocatable, intent(out) :: error From ea7b0c7f660502ddb1a8b14213de57a8efbaa841 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Jun 2023 23:48:15 +0700 Subject: [PATCH 264/304] Use deferred type parameter --- src/fpm_os.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_os.F90 b/src/fpm_os.F90 index f0e2f5437e..9de85e7584 100644 --- a/src/fpm_os.F90 +++ b/src/fpm_os.F90 @@ -246,7 +246,7 @@ subroutine get_absolute_path_by_cd(path, absolute_path, error) !> Converts a path to an absolute, canonical path. subroutine convert_to_absolute_path(path, error) - character(len=*), intent(inout) :: path + character(len=:), allocatable, intent(inout) :: path type(error_t), allocatable, intent(out) :: error character(len=:), allocatable :: absolute_path From faeba620a9eb4e98e89c32c890b5aecf90726352 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Fri, 16 Jun 2023 08:29:13 -0400 Subject: [PATCH 265/304] resolution for : Replace fixed-size character length of I/O lines to allocatable arrays #902 Remove fixed-length I/O by using the already-available getline(3f) procedure, which can read an arbitrary-length input line. This should resolve #902. --- src/fpm_filesystem.F90 | 39 ++++++++++++------------ src/fpm_strings.f90 | 69 ++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 85 insertions(+), 23 deletions(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index d5637357d1..8da411ccf2 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -6,7 +6,7 @@ module fpm_filesystem OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD use fpm_environment, only: separator, get_env, os_is_unix - use fpm_strings, only: f_string, replace, string_t, split, notabs, str_begins_with_str + use fpm_strings, only: f_string, replace, string_t, split, dilate, str_begins_with_str use iso_c_binding, only: c_char, c_ptr, c_int, c_null_char, c_associated, c_f_pointer use fpm_error, only : fpm_stop, error_t, fatal_error implicit none @@ -14,9 +14,8 @@ 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, execute_and_read_output, & + os_delete_dir, is_absolute_path, env_variable, get_home, execute_and_read_output, & get_dos_path - integer, parameter :: LINE_BUFFER_LEN = 32768 #ifndef FPM_BOOTSTRAP interface @@ -332,14 +331,13 @@ function read_lines_expanded(fh) result(lines) type(string_t), allocatable :: lines(:) integer :: i - integer :: ilen - character(LINE_BUFFER_LEN) :: line_buffer_read, line_buffer_expanded + integer :: iostat + character(len=:),allocatable :: line_buffer_read allocate(lines(number_of_rows(fh))) do i = 1, size(lines) - read(fh, '(A)') line_buffer_read - call notabs(line_buffer_read, line_buffer_expanded, ilen) - lines(i)%s = trim(line_buffer_expanded) + call getline(fh, line_buffer_read, iostat) + lines(i)%s = dilate(line_buffer_read) end do end function read_lines_expanded @@ -350,12 +348,11 @@ function read_lines(fh) result(lines) type(string_t), allocatable :: lines(:) integer :: i - character(LINE_BUFFER_LEN) :: line_buffer + integer :: iostat allocate(lines(number_of_rows(fh))) do i = 1, size(lines) - read(fh, '(A)') line_buffer - lines(i)%s = trim(line_buffer) + call getline(fh, lines(i)%s, iostat) end do end function read_lines @@ -560,6 +557,7 @@ logical function exists(filename) result(r) function get_temp_filename() result(tempfile) ! use iso_c_binding, only: c_ptr, C_NULL_PTR, c_f_pointer + integer, parameter :: MAX_FILENAME_LENGTH = 32768 character(:), allocatable :: tempfile type(c_ptr) :: c_tempfile_ptr @@ -582,7 +580,7 @@ end subroutine c_free end interface c_tempfile_ptr = c_tempnam(C_NULL_PTR, C_NULL_PTR) - call c_f_pointer(c_tempfile_ptr,c_tempfile,[LINE_BUFFER_LEN]) + call c_f_pointer(c_tempfile_ptr,c_tempfile,[MAX_FILENAME_LENGTH]) tempfile = f_string(c_tempfile) @@ -644,8 +642,9 @@ subroutine getline(unit, line, iostat, iomsg) !> Error message character(len=:), allocatable, optional :: iomsg - character(len=LINE_BUFFER_LEN) :: buffer - character(len=LINE_BUFFER_LEN) :: msg + integer, parameter :: FILENAME_MAX = 4096 + character(len=FILENAME_MAX) :: buffer + character(len=FILENAME_MAX) :: msg integer :: size integer :: stat @@ -1095,7 +1094,7 @@ subroutine execute_and_read_output(cmd, output, error, exitstat) integer :: cmdstat, unit, stat = 0 character(len=:), allocatable :: cmdmsg, tmp_file - character(len=1000) :: output_line + character(len=:),allocatable :: output_line tmp_file = get_temp_filename() @@ -1105,12 +1104,12 @@ subroutine execute_and_read_output(cmd, output, error, exitstat) open(newunit=unit, file=tmp_file, action='read', status='old') output = '' do - read(unit, *, iostat=stat) output_line - if (stat /= 0) exit - output = output//trim(output_line)//' ' + call getline(unit, output_line, stat) + if (stat /= 0) exit + output = output//output_line//' ' end do - close(unit, status='delete') - end + close(unit, status='delete',iostat=stat) + end subroutine execute_and_read_output !> Ensure a windows path is converted to an 8.3 DOS path if it contains spaces function get_dos_path(path,error) diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index e478f4dba6..6779437845 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -23,7 +23,8 @@ !! - [[IS_FORTRAN_NAME]] determine whether a string is an acceptable Fortran entity name !! - [[TO_FORTRAN_NAME]] replace allowed special but unusuable characters in names with underscore !!### Whitespace -!! - [[NOTABS]] Expand tab characters assuming a tab space every eight characters +!! - [[NOTABS]] subroutine to expand tab characters assuming a tab space every eight characters +!! - [[DILATE]] function to expand tab characters assuming a tab space every eight characters !! - [[LEN_TRIM]] Determine total trimmed length of **STRING_T** array !!### Miscellaneous !! - [[FNV_1A]] Hash a **CHARACTER(*)** string of default kind or a **TYPE(STRING_T)** array @@ -43,7 +44,7 @@ module fpm_strings public :: to_fortran_name, is_fortran_name public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a public :: replace, resize, str, join, glob -public :: notabs, remove_newline_characters +public :: notabs, dilate, remove_newline_characters !> Module naming public :: is_valid_module_name, is_valid_module_prefix, & @@ -1015,7 +1016,7 @@ pure function to_fortran_name(string) result(res) res = replace(string, SPECIAL_CHARACTERS, '_') end function to_fortran_name -function is_fortran_name(line) result (lout) +elemental function is_fortran_name(line) result (lout) ! determine if a string is a valid Fortran name ignoring trailing spaces ! (but not leading spaces) character(len=*),parameter :: int='0123456789' @@ -1365,4 +1366,66 @@ elemental impure subroutine notabs(instr,outstr,ilen) end subroutine notabs +!>AUTHOR: John S. Urban +!!LICENSE: Public Domain +!> +!!##NAME +!! dilate(3f) - [M_strings:NONALPHA] expand tab characters +!! (LICENSE:PD) +!! +!!##SYNOPSIS +!! +!! function dilate(INSTR) result(OUTSTR) +!! +!! character(len=*),intent=(in) :: INSTR +!! character(len=:),allocatable :: OUTSTR +!! +!!##DESCRIPTION +!! dilate() converts tabs in INSTR to spaces in OUTSTR. It assumes a +!! tab is set every 8 characters. Trailing spaces are removed. +!! +!! In addition, trailing carriage returns and line feeds are removed +!! (they are usually a problem created by going to and from MSWindows). +!! +!!##OPTIONS +!! instr Input line to remove tabs from +!! +!!##RESULTS +!! outstr Output string with tabs expanded. +!! +!!##EXAMPLES +!! +!! Sample program: +!! +!! program demo_dilate +!! +!! use M_strings, only : dilate +!! implicit none +!! character(len=:),allocatable :: in +!! integer :: i +!! in=' this is my string ' +!! ! change spaces to tabs to make a sample input +!! do i=1,len(in) +!! if(in(i:i) == ' ')in(i:i)=char(9) +!! enddo +!! write(*,'(a)')in,dilate(in) +!! end program demo_dilate +!! +function dilate(instr) result(outstr) + + character(len=*), intent(in) :: instr ! input line to scan for tab characters + character(len=:), allocatable :: outstr ! tab-expanded version of INSTR produced + integer :: i + integer :: icount + integer :: lgth + icount = 0 + do i = 1, len(instr) + if (instr(i:i) == char(9)) icount = icount + 1 + end do + allocate (character(len=(len(instr) + 8*icount)) :: outstr) + call notabs(instr, outstr, lgth) + outstr = outstr(:lgth) + +end function dilate + end module fpm_strings From b7e56132876943bf157f98f85eb4781b57cea8a6 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Fri, 16 Jun 2023 08:29:13 -0400 Subject: [PATCH 266/304] resolution for : Replace fixed-size character length of I/O lines to allocatable arrays #902 Remove fixed-length I/O by using the already-available getline(3f) procedure, which can read an arbitrary-length input line. This should resolve #902. --- src/fpm_filesystem.F90 | 39 ++++++++++++------------ src/fpm_strings.f90 | 69 ++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 85 insertions(+), 23 deletions(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index d5637357d1..8da411ccf2 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -6,7 +6,7 @@ module fpm_filesystem OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD use fpm_environment, only: separator, get_env, os_is_unix - use fpm_strings, only: f_string, replace, string_t, split, notabs, str_begins_with_str + use fpm_strings, only: f_string, replace, string_t, split, dilate, str_begins_with_str use iso_c_binding, only: c_char, c_ptr, c_int, c_null_char, c_associated, c_f_pointer use fpm_error, only : fpm_stop, error_t, fatal_error implicit none @@ -14,9 +14,8 @@ 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, execute_and_read_output, & + os_delete_dir, is_absolute_path, env_variable, get_home, execute_and_read_output, & get_dos_path - integer, parameter :: LINE_BUFFER_LEN = 32768 #ifndef FPM_BOOTSTRAP interface @@ -332,14 +331,13 @@ function read_lines_expanded(fh) result(lines) type(string_t), allocatable :: lines(:) integer :: i - integer :: ilen - character(LINE_BUFFER_LEN) :: line_buffer_read, line_buffer_expanded + integer :: iostat + character(len=:),allocatable :: line_buffer_read allocate(lines(number_of_rows(fh))) do i = 1, size(lines) - read(fh, '(A)') line_buffer_read - call notabs(line_buffer_read, line_buffer_expanded, ilen) - lines(i)%s = trim(line_buffer_expanded) + call getline(fh, line_buffer_read, iostat) + lines(i)%s = dilate(line_buffer_read) end do end function read_lines_expanded @@ -350,12 +348,11 @@ function read_lines(fh) result(lines) type(string_t), allocatable :: lines(:) integer :: i - character(LINE_BUFFER_LEN) :: line_buffer + integer :: iostat allocate(lines(number_of_rows(fh))) do i = 1, size(lines) - read(fh, '(A)') line_buffer - lines(i)%s = trim(line_buffer) + call getline(fh, lines(i)%s, iostat) end do end function read_lines @@ -560,6 +557,7 @@ logical function exists(filename) result(r) function get_temp_filename() result(tempfile) ! use iso_c_binding, only: c_ptr, C_NULL_PTR, c_f_pointer + integer, parameter :: MAX_FILENAME_LENGTH = 32768 character(:), allocatable :: tempfile type(c_ptr) :: c_tempfile_ptr @@ -582,7 +580,7 @@ end subroutine c_free end interface c_tempfile_ptr = c_tempnam(C_NULL_PTR, C_NULL_PTR) - call c_f_pointer(c_tempfile_ptr,c_tempfile,[LINE_BUFFER_LEN]) + call c_f_pointer(c_tempfile_ptr,c_tempfile,[MAX_FILENAME_LENGTH]) tempfile = f_string(c_tempfile) @@ -644,8 +642,9 @@ subroutine getline(unit, line, iostat, iomsg) !> Error message character(len=:), allocatable, optional :: iomsg - character(len=LINE_BUFFER_LEN) :: buffer - character(len=LINE_BUFFER_LEN) :: msg + integer, parameter :: FILENAME_MAX = 4096 + character(len=FILENAME_MAX) :: buffer + character(len=FILENAME_MAX) :: msg integer :: size integer :: stat @@ -1095,7 +1094,7 @@ subroutine execute_and_read_output(cmd, output, error, exitstat) integer :: cmdstat, unit, stat = 0 character(len=:), allocatable :: cmdmsg, tmp_file - character(len=1000) :: output_line + character(len=:),allocatable :: output_line tmp_file = get_temp_filename() @@ -1105,12 +1104,12 @@ subroutine execute_and_read_output(cmd, output, error, exitstat) open(newunit=unit, file=tmp_file, action='read', status='old') output = '' do - read(unit, *, iostat=stat) output_line - if (stat /= 0) exit - output = output//trim(output_line)//' ' + call getline(unit, output_line, stat) + if (stat /= 0) exit + output = output//output_line//' ' end do - close(unit, status='delete') - end + close(unit, status='delete',iostat=stat) + end subroutine execute_and_read_output !> Ensure a windows path is converted to an 8.3 DOS path if it contains spaces function get_dos_path(path,error) diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index e478f4dba6..6779437845 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -23,7 +23,8 @@ !! - [[IS_FORTRAN_NAME]] determine whether a string is an acceptable Fortran entity name !! - [[TO_FORTRAN_NAME]] replace allowed special but unusuable characters in names with underscore !!### Whitespace -!! - [[NOTABS]] Expand tab characters assuming a tab space every eight characters +!! - [[NOTABS]] subroutine to expand tab characters assuming a tab space every eight characters +!! - [[DILATE]] function to expand tab characters assuming a tab space every eight characters !! - [[LEN_TRIM]] Determine total trimmed length of **STRING_T** array !!### Miscellaneous !! - [[FNV_1A]] Hash a **CHARACTER(*)** string of default kind or a **TYPE(STRING_T)** array @@ -43,7 +44,7 @@ module fpm_strings public :: to_fortran_name, is_fortran_name public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a public :: replace, resize, str, join, glob -public :: notabs, remove_newline_characters +public :: notabs, dilate, remove_newline_characters !> Module naming public :: is_valid_module_name, is_valid_module_prefix, & @@ -1015,7 +1016,7 @@ pure function to_fortran_name(string) result(res) res = replace(string, SPECIAL_CHARACTERS, '_') end function to_fortran_name -function is_fortran_name(line) result (lout) +elemental function is_fortran_name(line) result (lout) ! determine if a string is a valid Fortran name ignoring trailing spaces ! (but not leading spaces) character(len=*),parameter :: int='0123456789' @@ -1365,4 +1366,66 @@ elemental impure subroutine notabs(instr,outstr,ilen) end subroutine notabs +!>AUTHOR: John S. Urban +!!LICENSE: Public Domain +!> +!!##NAME +!! dilate(3f) - [M_strings:NONALPHA] expand tab characters +!! (LICENSE:PD) +!! +!!##SYNOPSIS +!! +!! function dilate(INSTR) result(OUTSTR) +!! +!! character(len=*),intent=(in) :: INSTR +!! character(len=:),allocatable :: OUTSTR +!! +!!##DESCRIPTION +!! dilate() converts tabs in INSTR to spaces in OUTSTR. It assumes a +!! tab is set every 8 characters. Trailing spaces are removed. +!! +!! In addition, trailing carriage returns and line feeds are removed +!! (they are usually a problem created by going to and from MSWindows). +!! +!!##OPTIONS +!! instr Input line to remove tabs from +!! +!!##RESULTS +!! outstr Output string with tabs expanded. +!! +!!##EXAMPLES +!! +!! Sample program: +!! +!! program demo_dilate +!! +!! use M_strings, only : dilate +!! implicit none +!! character(len=:),allocatable :: in +!! integer :: i +!! in=' this is my string ' +!! ! change spaces to tabs to make a sample input +!! do i=1,len(in) +!! if(in(i:i) == ' ')in(i:i)=char(9) +!! enddo +!! write(*,'(a)')in,dilate(in) +!! end program demo_dilate +!! +function dilate(instr) result(outstr) + + character(len=*), intent(in) :: instr ! input line to scan for tab characters + character(len=:), allocatable :: outstr ! tab-expanded version of INSTR produced + integer :: i + integer :: icount + integer :: lgth + icount = 0 + do i = 1, len(instr) + if (instr(i:i) == char(9)) icount = icount + 1 + end do + allocate (character(len=(len(instr) + 8*icount)) :: outstr) + call notabs(instr, outstr, lgth) + outstr = outstr(:lgth) + +end function dilate + end module fpm_strings From bac6f602a650ff7902a96c27aab8b071e832acda Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Fri, 16 Jun 2023 16:25:08 -0400 Subject: [PATCH 267/304] Remove ENV_VARIABLE() as it duplicates the functionality of GET_ENV() The ENV_VARIABLE() procedure is performing functions already available in the GET_ENV() procedure. This changes the ENV_VARIABLE() calls to GET_ENV() calls to eliminate the duplication functionality. --- src/fpm_compiler.F90 | 1 - src/fpm_filesystem.F90 | 41 +++++++++-------------------------------- 2 files changed, 9 insertions(+), 33 deletions(-) diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index 2ba571cda5..02b99af135 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -28,7 +28,6 @@ module fpm_compiler use,intrinsic :: iso_fortran_env, only: stderr=>error_unit use fpm_environment, only: & - get_env, & get_os_type, & OS_LINUX, & OS_MACOS, & diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index d5637357d1..897063c6ff 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -14,7 +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, execute_and_read_output, & + LINE_BUFFER_LEN, os_delete_dir, is_absolute_path, get_home, execute_and_read_output, & get_dos_path integer, parameter :: LINE_BUFFER_LEN = 32768 @@ -54,29 +54,6 @@ end function c_is_dir contains - -!> return value of environment variable -subroutine env_variable(var, name) - character(len=:), allocatable, intent(out) :: var - character(len=*), intent(in) :: name - integer :: length, stat - - call get_environment_variable(name, length=length, status=stat) - if (stat /= 0) return - - allocate(character(len=length) :: var) - - if (length > 0) then - call get_environment_variable(name, var, status=stat) - if (stat /= 0) then - deallocate(var) - return - end if - end if - -end subroutine env_variable - - !> Extract filename from path with/without suffix function basename(path,suffix) result (base) @@ -1017,15 +994,15 @@ function get_local_prefix(os) result(prefix) character(len=:), allocatable :: home if (os_is_unix(os)) then - call env_variable(home, "HOME") - if (allocated(home)) then + home=get_env('HOME','') + if (home /= '' ) then prefix = join_path(home, ".local") else prefix = default_prefix_unix end if else - call env_variable(home, "APPDATA") - if (allocated(home)) then + home=get_env('APPDATA','') + if (home /= '' ) then prefix = join_path(home, "local") else prefix = default_prefix_win @@ -1068,14 +1045,14 @@ subroutine get_home(home, error) type(error_t), allocatable, intent(out) :: error if (os_is_unix()) then - call env_variable(home, 'HOME') - if (.not. allocated(home)) then + home=get_env('HOME','') + if ( home == '' ) then call fatal_error(error, "Couldn't retrieve 'HOME' variable") return end if else - call env_variable(home, 'USERPROFILE') - if (.not. allocated(home)) then + home=get_env('USERPROFILE','') + if ( home == '' ) then call fatal_error(error, "Couldn't retrieve '%USERPROFILE%' variable") return end if From f0337abb1ca6f82689a5c101047306babf01da73 Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Fri, 16 Jun 2023 16:42:28 -0400 Subject: [PATCH 268/304] change test_os.f90 accordingly --- test/fpm_test/test_os.f90 | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/test/fpm_test/test_os.f90 b/test/fpm_test/test_os.f90 index 594aa937a5..71989167f5 100644 --- a/test/fpm_test/test_os.f90 +++ b/test/fpm_test/test_os.f90 @@ -1,7 +1,7 @@ module test_os use testsuite, only: new_unittest, unittest_t, error_t, test_failed - use fpm_filesystem, only: env_variable, join_path, mkdir, os_delete_dir, is_dir, get_local_prefix, get_home - use fpm_environment, only: os_is_unix + use fpm_filesystem, only: join_path, mkdir, os_delete_dir, is_dir, get_local_prefix, get_home + use fpm_environment, only: os_is_unix, get_env use fpm_os, only: get_absolute_path, get_absolute_path_by_cd, get_current_directory implicit none @@ -134,7 +134,7 @@ subroutine abs_path_nonexisting(error) subroutine abs_path_root(error) type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: home_drive, home_path, result + character(len=:), allocatable :: home_path, result if (os_is_unix()) then call get_absolute_path('/', result, error) @@ -144,8 +144,7 @@ subroutine abs_path_root(error) call test_failed(error, "Result '"//result//"' doesn't equal input value: '/'"); return end if else - call env_variable(home_drive, 'HOMEDRIVE') - home_path = home_drive//'\' + home_path = get_env('HOMEDRIVE','') //'\' call get_absolute_path(home_path, result, error) if (allocated(error)) return @@ -177,7 +176,7 @@ subroutine abs_path_home(error) subroutine abs_path_cd_root(error) type(error_t), allocatable, intent(out) :: error - character(len=:), allocatable :: home_drive, home_path, current_dir_before, current_dir_after, result + character(len=:), allocatable :: home_path, current_dir_before, current_dir_after, result call get_current_directory(current_dir_before, error) if (allocated(error)) return @@ -189,8 +188,7 @@ subroutine abs_path_cd_root(error) call test_failed(error, "Result '"//result//"' doesn't equal input value: '/'"); return end if else - call env_variable(home_drive, 'HOMEDRIVE') - home_path = home_drive//'\' + home_path = get_env('HOMEDRIVE','')//'\' call get_absolute_path_by_cd(home_path, result, error) From 40b78880de10e7ebf843a4e6802a9ccfaaf864b1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 17 Jun 2023 15:10:30 +0200 Subject: [PATCH 269/304] add `runner_args` to cli --- src/fpm_command_line.f90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index f1ced79308..5f36382bb2 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -90,6 +90,7 @@ module fpm_command_line character(len=ibug),allocatable :: name(:) character(len=:),allocatable :: args character(len=:),allocatable :: runner + character(len=:),allocatable :: runner_args logical :: example end type @@ -141,7 +142,7 @@ module fpm_command_line & 'test', 'runner', 'install', 'update', 'list', 'help', 'version', 'publish' ] character(len=:), allocatable :: val_runner, val_compiler, val_flag, val_cflag, val_cxxflag, val_ldflag, & - val_profile + val_profile, val_runner_args ! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',& character(len=80), parameter :: help_text_build_common(*) = [character(len=80) :: & @@ -268,7 +269,8 @@ subroutine get_command_line_settings(cmd_settings) run_args = & ' --target " "' // & ' --list F' // & - ' --runner " "' + ' --runner " "'// & + ' --runner-args " "' compiler_args = & ' --profile " "' // & @@ -322,7 +324,8 @@ subroutine get_command_line_settings(cmd_settings) archiver = sget('archiver') allocate(fpm_run_settings :: cmd_settings) val_runner=sget('runner') - if(specified('runner') .and. val_runner=='')val_runner='echo' + val_runner_args=sget('runner-args') + if (specified('runner') .and. val_runner=='')val_runner='echo' cmd_settings=fpm_run_settings(& & args=remaining,& & profile=val_profile,& @@ -340,6 +343,7 @@ subroutine get_command_line_settings(cmd_settings) & build_tests=.false.,& & name=names,& & runner=val_runner,& + & runner_args=val_runner_args,& & verbose=lget('verbose') ) case('build') @@ -571,6 +575,7 @@ subroutine get_command_line_settings(cmd_settings) allocate(fpm_test_settings :: cmd_settings) val_runner=sget('runner') if(specified('runner') .and. val_runner=='')val_runner='echo' + val_runner_args=sget('runner-args') cmd_settings=fpm_test_settings(& & args=remaining, & & profile=val_profile, & @@ -588,6 +593,7 @@ subroutine get_command_line_settings(cmd_settings) & build_tests=.true., & & name=names, & & runner=val_runner, & + & runner_args=val_runner_args, & & verbose=lget('verbose') ) case('update') From 8485e9467742653e2b68bd409b33965a8d11ce1c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 17 Jun 2023 15:17:28 +0200 Subject: [PATCH 270/304] add runner_command function --- src/fpm_command_line.f90 | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 5f36382bb2..b45a9c592a 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -92,6 +92,8 @@ module fpm_command_line character(len=:),allocatable :: runner character(len=:),allocatable :: runner_args logical :: example + contains + procedure :: runner_command end type type, extends(fpm_run_settings) :: fpm_test_settings @@ -1436,4 +1438,21 @@ function get_fpm_env(env, default) result(val) val = get_env(fpm_prefix//env, default) end function get_fpm_env + !> Build a full runner command (executable + command-line arguments) + function runner_command(cmd) result(run_cmd) + class(fpm_run_settings), intent(in) :: cmd + character(len=:), allocatable :: run_cmd + + !> Get executable + if (len_trim(cmd%runner)>0) then + run_cmd = trim(cmd%runner) + else + run_cmd = '' + end if + + !> Append command-line arguments + if (len_trim(cmd%runner_args)>0) run_cmd = run_cmd//' '//trim(cmd%runner_args) + + end function runner_command + end module fpm_command_line From 4a515ebb124ee6a85d6c3cf5968d8f208fe59e1b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 17 Jun 2023 15:23:35 +0200 Subject: [PATCH 271/304] Revert "add `runner_args` to cli" This reverts commit 40b78880de10e7ebf843a4e6802a9ccfaaf864b1. --- src/fpm_command_line.f90 | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index b45a9c592a..2c75ef10a4 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -90,7 +90,6 @@ module fpm_command_line character(len=ibug),allocatable :: name(:) character(len=:),allocatable :: args character(len=:),allocatable :: runner - character(len=:),allocatable :: runner_args logical :: example contains procedure :: runner_command @@ -144,7 +143,7 @@ module fpm_command_line & 'test', 'runner', 'install', 'update', 'list', 'help', 'version', 'publish' ] character(len=:), allocatable :: val_runner, val_compiler, val_flag, val_cflag, val_cxxflag, val_ldflag, & - val_profile, val_runner_args + val_profile ! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',& character(len=80), parameter :: help_text_build_common(*) = [character(len=80) :: & @@ -271,8 +270,7 @@ subroutine get_command_line_settings(cmd_settings) run_args = & ' --target " "' // & ' --list F' // & - ' --runner " "'// & - ' --runner-args " "' + ' --runner " "' compiler_args = & ' --profile " "' // & @@ -326,8 +324,7 @@ subroutine get_command_line_settings(cmd_settings) archiver = sget('archiver') allocate(fpm_run_settings :: cmd_settings) val_runner=sget('runner') - val_runner_args=sget('runner-args') - if (specified('runner') .and. val_runner=='')val_runner='echo' + if(specified('runner') .and. val_runner=='')val_runner='echo' cmd_settings=fpm_run_settings(& & args=remaining,& & profile=val_profile,& @@ -345,7 +342,6 @@ subroutine get_command_line_settings(cmd_settings) & build_tests=.false.,& & name=names,& & runner=val_runner,& - & runner_args=val_runner_args,& & verbose=lget('verbose') ) case('build') @@ -577,7 +573,6 @@ subroutine get_command_line_settings(cmd_settings) allocate(fpm_test_settings :: cmd_settings) val_runner=sget('runner') if(specified('runner') .and. val_runner=='')val_runner='echo' - val_runner_args=sget('runner-args') cmd_settings=fpm_test_settings(& & args=remaining, & & profile=val_profile, & @@ -595,7 +590,6 @@ subroutine get_command_line_settings(cmd_settings) & build_tests=.true., & & name=names, & & runner=val_runner, & - & runner_args=val_runner_args, & & verbose=lget('verbose') ) case('update') From 413073f0bcb7aac0f32b9a72efebc21105e4560c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 17 Jun 2023 15:23:39 +0200 Subject: [PATCH 272/304] Revert "add runner_command function" This reverts commit 8485e9467742653e2b68bd409b33965a8d11ce1c. --- src/fpm_command_line.f90 | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 2c75ef10a4..f1ced79308 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -91,8 +91,6 @@ module fpm_command_line character(len=:),allocatable :: args character(len=:),allocatable :: runner logical :: example - contains - procedure :: runner_command end type type, extends(fpm_run_settings) :: fpm_test_settings @@ -1432,21 +1430,4 @@ function get_fpm_env(env, default) result(val) val = get_env(fpm_prefix//env, default) end function get_fpm_env - !> Build a full runner command (executable + command-line arguments) - function runner_command(cmd) result(run_cmd) - class(fpm_run_settings), intent(in) :: cmd - character(len=:), allocatable :: run_cmd - - !> Get executable - if (len_trim(cmd%runner)>0) then - run_cmd = trim(cmd%runner) - else - run_cmd = '' - end if - - !> Append command-line arguments - if (len_trim(cmd%runner_args)>0) run_cmd = run_cmd//' '//trim(cmd%runner_args) - - end function runner_command - end module fpm_command_line From 86e3d18221890a48963c09c7189708213ec08a6c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 17 Jun 2023 16:00:28 +0200 Subject: [PATCH 273/304] add `runner-args` option --- src/fpm.f90 | 6 +++-- src/fpm_command_line.f90 | 48 ++++++++++++++++++++++++++++++++----- src/fpm_meta.f90 | 7 ++---- src/fpm_strings.f90 | 51 ++++++++++++++++++++++++++-------------- 4 files changed, 81 insertions(+), 31 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index e8ad5f255f..3fee264618 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -543,6 +543,8 @@ subroutine cmd_run(settings,test) end if end if + + ! Check all names are valid ! or no name and found more than one file toomany= size(settings%name)==0 .and. size(executables)>1 @@ -587,10 +589,10 @@ subroutine cmd_run(settings,test) if (exists(executables(i)%s)) then if(settings%runner /= ' ')then if(.not.allocated(settings%args))then - call run(settings%runner//' '//executables(i)%s, & + call run(settings%runner_command()//' '//executables(i)%s, & echo=settings%verbose, exitstat=stat(i)) else - call run(settings%runner//' '//executables(i)%s//" "//settings%args, & + call run(settings%runner_command()//' '//executables(i)%s//" "//settings%args, & echo=settings%verbose, exitstat=stat(i)) endif else diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index f1ced79308..552320cd22 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -28,7 +28,7 @@ module fpm_command_line OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified use M_CLI2, only : get_subcommand, CLI_RESPONSE_FILE -use fpm_strings, only : lower, split, to_fortran_name, is_fortran_name +use fpm_strings, only : lower, split, to_fortran_name, is_fortran_name, remove_characters_in_set, string_t use fpm_filesystem, only : basename, canon_path, which, run use fpm_environment, only : get_command_arguments_quoted use fpm_error, only : fpm_stop, error_t @@ -88,9 +88,12 @@ module fpm_command_line type, extends(fpm_build_settings) :: fpm_run_settings character(len=ibug),allocatable :: name(:) - character(len=:),allocatable :: args + character(len=:),allocatable :: args ! passed to the app character(len=:),allocatable :: runner + character(len=:),allocatable :: runner_args ! passed to the runner logical :: example + contains + procedure :: runner_command end type type, extends(fpm_run_settings) :: fpm_test_settings @@ -141,7 +144,7 @@ module fpm_command_line & 'test', 'runner', 'install', 'update', 'list', 'help', 'version', 'publish' ] character(len=:), allocatable :: val_runner, val_compiler, val_flag, val_cflag, val_cxxflag, val_ldflag, & - val_profile + val_profile, val_runner_args ! '12345678901234567890123456789012345678901234567890123456789012345678901234567890',& character(len=80), parameter :: help_text_build_common(*) = [character(len=80) :: & @@ -268,7 +271,8 @@ subroutine get_command_line_settings(cmd_settings) run_args = & ' --target " "' // & ' --list F' // & - ' --runner " "' + ' --runner " "' // & + ' --runner-args " "' compiler_args = & ' --profile " "' // & @@ -317,12 +321,17 @@ subroutine get_command_line_settings(cmd_settings) if(names(i)=='..')names(i)='*' enddo + ! If there are additional command-line arguments, remove the additional + ! double quotes which have been added by M_CLI2 + call remove_characters_in_set(remaining,set='"') + c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') allocate(fpm_run_settings :: cmd_settings) val_runner=sget('runner') if(specified('runner') .and. val_runner=='')val_runner='echo' + val_runner_args=sget('runner-args') cmd_settings=fpm_run_settings(& & args=remaining,& & profile=val_profile,& @@ -340,6 +349,7 @@ subroutine get_command_line_settings(cmd_settings) & build_tests=.false.,& & name=names,& & runner=val_runner,& + & runner_args=val_runner_args, & & verbose=lget('verbose') ) case('build') @@ -565,12 +575,17 @@ subroutine get_command_line_settings(cmd_settings) if(names(i)=='..')names(i)='*' enddo + ! If there are additional command-line arguments, remove the additional + ! double quotes which have been added by M_CLI2 + call remove_characters_in_set(remaining,set='"') + c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') archiver = sget('archiver') allocate(fpm_test_settings :: cmd_settings) val_runner=sget('runner') if(specified('runner') .and. val_runner=='')val_runner='echo' + val_runner_args=sget('runner-args') cmd_settings=fpm_test_settings(& & args=remaining, & & profile=val_profile, & @@ -588,6 +603,7 @@ subroutine get_command_line_settings(cmd_settings) & build_tests=.true., & & name=names, & & runner=val_runner, & + & runner_args=val_runner_args, & & verbose=lget('verbose') ) case('update') @@ -768,7 +784,7 @@ subroutine set_help() ' executables. ', & ' ', & 'SYNOPSIS ', & - ' fpm run|test --runner CMD ... -- SUFFIX_OPTIONS ', & + ' fpm run|test --runner CMD ... --runner-args ARGS -- SUFFIX_OPTIONS ', & ' ', & 'DESCRIPTION ', & ' The --runner option allows specifying a program to launch ', & @@ -784,8 +800,11 @@ subroutine set_help() ' Available for both the "run" and "test" subcommands. ', & ' If the keyword is specified without a value the default command ', & ' is "echo". ', & + ' --runner-args "args" an additional option to pass command-line arguments ', & + ' to the runner command, instead of to the fpm app. ', & ' -- SUFFIX_OPTIONS additional options to suffix the command CMD and executable ', & - ' file names with. ', & + ' file names with. These options are passed as command-line ', & + ' arguments to the app. ', & 'EXAMPLES ', & ' Use cases for ''fpm run|test --runner "CMD"'' include employing ', & ' the following common GNU/Linux and Unix commands: ', & @@ -814,6 +833,7 @@ subroutine set_help() ' ', & ' fpm test --runner gdb ', & ' fpm run --runner "tar cvfz $HOME/bundle.tgz" ', & + ' fpm run --runner "mpiexec" --runner-args "-np 12" ', & ' fpm run --runner ldd ', & ' fpm run --runner strip ', & ' fpm run --runner ''cp -t /usr/local/bin'' ', & @@ -1430,4 +1450,20 @@ function get_fpm_env(env, default) result(val) val = get_env(fpm_prefix//env, default) end function get_fpm_env + + !> Build a full runner command (executable + command-line arguments) + function runner_command(cmd) result(run_cmd) + class(fpm_run_settings), intent(in) :: cmd + character(len=:), allocatable :: run_cmd + !> Get executable + if (len_trim(cmd%runner)>0) then + run_cmd = trim(cmd%runner) + else + run_cmd = '' + end if + !> Append command-line arguments + if (len_trim(cmd%runner_args)>0) run_cmd = run_cmd//' '//trim(cmd%runner_args) + end function runner_command + + end module fpm_command_line diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 9df0c6c2bb..9c5997f1aa 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -289,11 +289,8 @@ subroutine resolve_cmd(self,settings,error) select type (cmd=>settings) class is (fpm_run_settings) ! includes fpm_test_settings - if (.not.allocated(cmd%runner)) then - cmd%runner = self%run_command%s - else - cmd%runner = self%run_command%s//' '//cmd%runner - end if + ! Only override runner if user has not provided a custom one + if (.not.len_trim(cmd%runner)>0) cmd%runner = self%run_command%s end select diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index e478f4dba6..f71b23a1b1 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -43,7 +43,7 @@ module fpm_strings public :: to_fortran_name, is_fortran_name public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a public :: replace, resize, str, join, glob -public :: notabs, remove_newline_characters +public :: notabs, remove_newline_characters, remove_characters_in_set !> Module naming public :: is_valid_module_name, is_valid_module_prefix, & @@ -1220,44 +1220,59 @@ logical function has_valid_standard_prefix(module_name,package_name) result(vali end function has_valid_standard_prefix -! Remove all new line characters from the current string, replace them with spaces -subroutine remove_newline_characters(string) - type(string_t), intent(inout) :: string +! Remove all characters from a set from a string +subroutine remove_characters_in_set(string,set,replace_with) + character(len=:), allocatable, intent(inout) :: string + character(*), intent(in) :: set + character, optional, intent(in) :: replace_with ! Replace with this character instead of removing integer :: feed,length - character(*), parameter :: CRLF = new_line('a')//achar(13) - character(*), parameter :: SPACE = ' ' + if (.not.allocated(string)) return + if (len(set)<=0) return - if (.not.allocated(string%s)) return - - - length = len(string%s) - feed = scan(string%s,CRLF) + length = len(string) + feed = scan(string,set) do while (length>0 .and. feed>0) ! Remove heading if (length==1) then - string = string_t("") + string = "" elseif (feed==1) then - string%s = string%s(2:length) + string = string(2:length) ! Remove trailing elseif (feed==length) then - string%s = string%s(1:length-1) + string = string(1:length-1) - ! In between: replace with space + ! In between: replace with given character + elseif (present(replace_with)) then + string(feed:feed) = replace_with + ! Or just remove else - string%s(feed:feed) = SPACE + string = string(1:feed-1)//string(feed+1:length) end if - length = len(string%s) - feed = scan(string%s,CRLF) + length = len(string) + feed = scan(string,set) end do +end subroutine remove_characters_in_set + +! Remove all new line characters from the current string, replace them with spaces +subroutine remove_newline_characters(string) + type(string_t), intent(inout) :: string + + integer :: feed,length + + character(*), parameter :: CRLF = new_line('a')//achar(13) + character(*), parameter :: SPACE = ' ' + + call remove_characters_in_set(string%s,set=CRLF,replace_with=SPACE) + end subroutine remove_newline_characters !>AUTHOR: John S. Urban From d3c3a16087f6224051f6fdecbb4fd4a0a2763ae3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sat, 17 Jun 2023 16:15:18 +0200 Subject: [PATCH 274/304] fix app args --- src/fpm_command_line.f90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index 552320cd22..b895d5f6dc 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -323,7 +323,8 @@ subroutine get_command_line_settings(cmd_settings) ! If there are additional command-line arguments, remove the additional ! double quotes which have been added by M_CLI2 - call remove_characters_in_set(remaining,set='"') + val_runner_args=sget('runner-args') + call remove_characters_in_set(val_runner_args,set='"') c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') @@ -331,7 +332,7 @@ subroutine get_command_line_settings(cmd_settings) allocate(fpm_run_settings :: cmd_settings) val_runner=sget('runner') if(specified('runner') .and. val_runner=='')val_runner='echo' - val_runner_args=sget('runner-args') + cmd_settings=fpm_run_settings(& & args=remaining,& & profile=val_profile,& @@ -577,7 +578,8 @@ subroutine get_command_line_settings(cmd_settings) ! If there are additional command-line arguments, remove the additional ! double quotes which have been added by M_CLI2 - call remove_characters_in_set(remaining,set='"') + val_runner_args=sget('runner-args') + call remove_characters_in_set(val_runner_args,set='"') c_compiler = sget('c-compiler') cxx_compiler = sget('cxx-compiler') @@ -585,7 +587,7 @@ subroutine get_command_line_settings(cmd_settings) allocate(fpm_test_settings :: cmd_settings) val_runner=sget('runner') if(specified('runner') .and. val_runner=='')val_runner='echo' - val_runner_args=sget('runner-args') + cmd_settings=fpm_test_settings(& & args=remaining, & & profile=val_profile, & From f3d2c1366d8604738711085cc28d5469ec771bf5 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 17 Jun 2023 22:30:00 +0700 Subject: [PATCH 275/304] Use run --- src/fpm/downloader.f90 | 12 +++++------- src/fpm/git.f90 | 26 +++++--------------------- src/fpm_filesystem.F90 | 20 ++++++++++++++------ 3 files changed, 24 insertions(+), 34 deletions(-) diff --git a/src/fpm/downloader.f90 b/src/fpm/downloader.f90 index b557d3ded6..c481324fd4 100644 --- a/src/fpm/downloader.f90 +++ b/src/fpm/downloader.f90 @@ -1,6 +1,6 @@ module fpm_downloader use fpm_error, only: error_t, fatal_error - use fpm_filesystem, only: which + use fpm_filesystem, only: which, run use fpm_versioning, only: version_t use jonquil, only: json_object, json_value, json_error, json_load, cast_to_object use fpm_strings, only: string_t @@ -81,25 +81,23 @@ subroutine upload_form(endpoint, form_data, verbose, error) character(len=*), intent(in) :: endpoint !> Form data to upload. type(string_t), intent(in) :: form_data(:) - !> Print additional information when true. + !> Print additional information if true. logical, intent(in) :: verbose !> Error handling. type(error_t), allocatable, intent(out) :: error integer :: stat, i - character(len=:), allocatable :: form_data_str, cmd + character(len=:), allocatable :: form_data_str form_data_str = '' do i = 1, size(form_data) form_data_str = form_data_str//"-F '"//form_data(i)%s//"' " end do - cmd = 'curl -X POST -H "Content-Type: multipart/form-data" '//form_data_str//endpoint - if (which('curl') /= '') then print *, 'Uploading package ...' - if (verbose) print *, ' + ', cmd - call execute_command_line(cmd, exitstat=stat) + call run('curl -X POST -H "Content-Type: multipart/form-data" '// & + & form_data_str//endpoint, exitstat=stat, verbose=verbose) else call fatal_error(error, "'curl' not installed."); return end if diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index b053427583..602c3c0439 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -1,7 +1,8 @@ !> Implementation for interacting with git repositories. module fpm_git use fpm_error, only: error_t, fatal_error - use fpm_filesystem, only : get_temp_filename, getline, join_path, execute_and_read_output + use fpm_filesystem, only : get_temp_filename, getline, join_path, execute_and_read_output, run + implicit none public :: git_target_t, git_target_default, git_target_branch, git_target_tag, git_target_revision, git_revision, & @@ -321,35 +322,18 @@ subroutine git_archive(source, destination, ref, verbose, error) type(error_t), allocatable, intent(out) :: error integer :: stat - character(len=:), allocatable :: cmd_output, archive_format, cmd - - if (verbose) then - print *, '' - print *, 'Show git archive options:' - print *, ' + git archive -l' - end if + character(len=:), allocatable :: cmd_output, archive_format - call execute_and_read_output('git archive -l', cmd_output, error) + call execute_and_read_output('git archive -l', cmd_output, error, verbose) if (allocated(error)) return - if (verbose) print *, ' ', cmd_output - if (index(cmd_output, 'tar.gz') /= 0) then archive_format = 'tar.gz' else call fatal_error(error, "Cannot find a suitable archive format for 'git archive'."); return end if - cmd = 'git archive '//ref//' --format='//archive_format//' -o '//destination - - if (verbose) then - print *, '' - print *, 'Archive ', ref, ' using ', archive_format, ':' - print *, ' + ', cmd - print *, '' - end if - - call execute_command_line(cmd, exitstat=stat) + call run('git archive '//ref//' --format='//archive_format//' -o '//destination, echo=verbose, 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 d5637357d1..7e77000a2f 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -1083,24 +1083,31 @@ subroutine get_home(home, error) end subroutine get_home !> Execute command line and return output as a string. - subroutine execute_and_read_output(cmd, output, error, exitstat) + subroutine execute_and_read_output(cmd, output, error, verbose) !> Command to execute. character(len=*), intent(in) :: cmd !> Command line output. character(len=:), allocatable, intent(out) :: output !> Error to handle. type(error_t), allocatable, intent(out) :: error - !> Can optionally used for error handling. - integer, intent(out), optional :: exitstat + !> Print additional information if true. + logical, intent(in), optional :: verbose - integer :: cmdstat, unit, stat = 0 + integer :: exitstat, unit, stat = 0 character(len=:), allocatable :: cmdmsg, tmp_file character(len=1000) :: output_line + logical :: is_verbose + + if (present(verbose)) then + is_verbose = verbose + else + is_verbose = .false. + end if tmp_file = get_temp_filename() - 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 run(cmd//' > '//tmp_file, exitstat=exitstat, echo=is_verbose) + if (exitstat /= 0) call fatal_error(error, '*run*: '//"Command failed: '"//cmd//"'. Message: '"//trim(cmdmsg)//"'.") open(newunit=unit, file=tmp_file, action='read', status='old') output = '' @@ -1109,6 +1116,7 @@ subroutine execute_and_read_output(cmd, output, error, exitstat) if (stat /= 0) exit output = output//trim(output_line)//' ' end do + if (is_verbose) print *, output close(unit, status='delete') end From 21a71de61c6d4ceb2c4f16749839662a63889cdf Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 17 Jun 2023 22:55:14 +0700 Subject: [PATCH 276/304] Do not initialize stat --- src/fpm_filesystem.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 45d748831d..b493b2e886 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -1152,7 +1152,7 @@ subroutine execute_and_read_output(cmd, output, error, verbose) !> Print additional information if true. logical, intent(in), optional :: verbose - integer :: exitstat, unit, stat = 0 + integer :: exitstat, unit, stat character(len=:), allocatable :: cmdmsg, tmp_file, output_line logical :: is_verbose @@ -1175,7 +1175,7 @@ subroutine execute_and_read_output(cmd, output, error, verbose) output = output//output_line//' ' end do if (is_verbose) print *, output - close(unit, status='delete', iostat=stat) + close(unit, status='delete') end !> Ensure a windows path is converted to an 8.3 DOS path if it contains spaces From 1b38b982c2a586eedc96b05f3e1cbe0e5ddbeae1 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 18 Jun 2023 09:45:57 +0700 Subject: [PATCH 277/304] Change verbose to echo --- src/fpm/downloader.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/downloader.f90 b/src/fpm/downloader.f90 index c481324fd4..39a3314ccf 100644 --- a/src/fpm/downloader.f90 +++ b/src/fpm/downloader.f90 @@ -97,7 +97,7 @@ subroutine upload_form(endpoint, form_data, verbose, error) if (which('curl') /= '') then print *, 'Uploading package ...' call run('curl -X POST -H "Content-Type: multipart/form-data" '// & - & form_data_str//endpoint, exitstat=stat, verbose=verbose) + & form_data_str//endpoint, exitstat=stat, echo=verbose) else call fatal_error(error, "'curl' not installed."); return end if From 953c57665d599d129564460ce354d29bfbe4b390 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 18 Jun 2023 10:01:07 +0700 Subject: [PATCH 278/304] Nit --- src/fpm/git.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm/git.f90 b/src/fpm/git.f90 index 602c3c0439..c007743a90 100644 --- a/src/fpm/git.f90 +++ b/src/fpm/git.f90 @@ -316,7 +316,7 @@ subroutine git_archive(source, destination, ref, verbose, error) character(*), intent(in) :: destination !> (Symbolic) Reference to be archived. character(*), intent(in) :: ref - !> Print additional information when true. + !> Print additional information if true. logical, intent(in) :: verbose !> Error handling. type(error_t), allocatable, intent(out) :: error From d69203ebca55688c57ed138d66c34d03a4f5adcd Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 18 Jun 2023 14:51:25 +0200 Subject: [PATCH 279/304] use clang as the brew compiler --- .github/workflows/meta.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 93075fd812..0423fe90f8 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -198,7 +198,7 @@ jobs: - name: (macOS) Install homebrew OpenMPI if: contains(matrix.mpi,'openmpi') && contains(matrix.os,'macos') run: | - brew install --cc=gcc-${{ env.GCC_V }} openmpi + brew install openmpi #--cc=gcc-${{ env.GCC_V }} openmpi # Phase 1: Bootstrap fpm with existing version - name: Install fpm From e279d452405440e4bc4b1d920777d9a4f1606436 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 18 Jun 2023 14:52:25 +0200 Subject: [PATCH 280/304] fix comment --- src/fpm_meta.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index c8fd4171de..c610e5ad4f 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -8,6 +8,10 @@ !>### Available core libraries !> !> - OpenMP +!> - MPI +!> - fortran-lang stdlib +!> - fortran-lang minpack +!> !> !> @note Core libraries are enabled in the [build] section of the fpm.toml manifest !> From b937d646850054db2942e9f18e63a817c5f7eb4a Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 19 Jun 2023 01:10:21 +0700 Subject: [PATCH 281/304] 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 From 702ee64655f5b1bf629857bbfbd7a5bfb2e0d0f7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 18 Jun 2023 22:07:06 +0200 Subject: [PATCH 282/304] try homebrew-no-auto-update --- .github/workflows/meta.yml | 2 +- src/fpm_meta.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 0423fe90f8..6370d6dc11 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -15,7 +15,7 @@ on: env: CI: "ON" # We can detect this in the build system and other vendors implement it HOMEBREW_NO_ANALYTICS: "ON" # Make Homebrew installation a little quicker - HOMEBREW_NO_AUTO_UPDATE: "ON" + HOMEBREW_NO_AUTO_UPDATE: 1 HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: "ON" HOMEBREW_NO_GITHUB_API: "ON" HOMEBREW_NO_INSTALL_CLEANUP: "ON" diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index c610e5ad4f..432d17495f 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -3,7 +3,7 @@ !> This is a wrapper data type that encapsulate all pre-processing information !> (compiler flags, linker libraries, etc.) required to correctly enable a package !> to use a core library. -!> +!> !> !>### Available core libraries !> From 2a4dba56c5c0727ea81cceecb7ba22a46fd87007 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 18 Jun 2023 22:12:47 +0200 Subject: [PATCH 283/304] make all homebrew variables `1` instead of `"ON"` --- .github/workflows/meta.yml | 8 ++++---- src/fpm_meta.f90 | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 6370d6dc11..8bf64314d6 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -14,11 +14,11 @@ on: env: CI: "ON" # We can detect this in the build system and other vendors implement it - HOMEBREW_NO_ANALYTICS: "ON" # Make Homebrew installation a little quicker + HOMEBREW_NO_ANALYTICS: 1 # Make Homebrew installation a little quicker HOMEBREW_NO_AUTO_UPDATE: 1 - HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: "ON" - HOMEBREW_NO_GITHUB_API: "ON" - HOMEBREW_NO_INSTALL_CLEANUP: "ON" + HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: 1 + HOMEBREW_NO_GITHUB_API: 1 + HOMEBREW_NO_INSTALL_CLEANUP: 1 jobs: diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 432d17495f..92b755dd6a 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -5,7 +5,7 @@ !> to use a core library. !> !> -!>### Available core libraries +!>### Available core libraries !> !> - OpenMP !> - MPI From be67bc619f7e206f83e926ce96509fd5789b2fb5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Sun, 18 Jun 2023 22:18:11 +0200 Subject: [PATCH 284/304] do not check installed dependents --- .github/workflows/meta.yml | 1 + src/fpm_meta.f90 | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 8bf64314d6..86b5215c53 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -19,6 +19,7 @@ env: HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: 1 HOMEBREW_NO_GITHUB_API: 1 HOMEBREW_NO_INSTALL_CLEANUP: 1 + HOMEBREW_NO_INSTALLED_DEPENDENTS_CHECK: 1 jobs: diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 92b755dd6a..f86e3a6b27 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -3,7 +3,7 @@ !> This is a wrapper data type that encapsulate all pre-processing information !> (compiler flags, linker libraries, etc.) required to correctly enable a package !> to use a core library. -!> +!> !> !>### Available core libraries !> From bf88610a82d0ec44e6ee89c7c7f7b53b0e3e48db Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 19 Jun 2023 08:26:17 +0200 Subject: [PATCH 285/304] fpm_filesystem.F90: fix broken resolve conflicts --- src/fpm_filesystem.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 9d2d8f896e..81c5628e40 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, get_home, execute_and_read_output, & - get_dos_path + os_delete_dir, is_absolute_path, get_home, execute_and_read_output, get_dos_path #ifndef FPM_BOOTSTRAP interface From 16aca47389449a1b5510e341eea8af48c47359bc Mon Sep 17 00:00:00 2001 From: "John S. Urban" Date: Wed, 21 Jun 2023 06:23:37 -0400 Subject: [PATCH 286/304] update jonquil version --- fpm.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm.toml b/fpm.toml index 90b1712f66..1da1a00dcf 100644 --- a/fpm.toml +++ b/fpm.toml @@ -17,7 +17,7 @@ M_CLI2.rev = "7264878cdb1baff7323cc48596d829ccfe7751b8" fortran-regex.git = "https://github.com/perazz/fortran-regex" fortran-regex.tag = "1.1.2" jonquil.git = "https://github.com/toml-f/jonquil" -jonquil.rev = "4c27c8c1e411fa8790dffcf8c3fa7a27b6322273" +jonquil.rev = "4fbd4cf34d577c0fd25e32667ee9e41bf231ece8" [[test]] name = "cli-test" From f87fac1d688a411936cf5cbc0eb0c4845056470b Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 22 Jun 2023 00:02:18 +0700 Subject: [PATCH 287/304] Clean up clean command --- src/fpm.f90 | 35 +++++++++++++++++++---------------- src/fpm_command_line.f90 | 16 +++++----------- 2 files changed, 24 insertions(+), 27 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 9e82b91d97..50d39a8842 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -21,10 +21,12 @@ module fpm use fpm_manifest, only : get_package_data, package_config_t use fpm_meta, only : resolve_metapackages use fpm_error, only : error_t, fatal_error, fpm_stop -use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & - & stdout=>output_unit, & - & stderr=>error_unit +use, intrinsic :: iso_fortran_env, only : stdin => input_unit, & + & stdout => output_unit, & + & stderr => error_unit use iso_c_binding, only: c_char, c_ptr, c_int, c_null_char, c_associated, c_f_pointer +use fpm_environment, only: os_is_unix + implicit none private public :: cmd_build, cmd_run, cmd_clean @@ -676,27 +678,28 @@ subroutine delete_skip(is_unix) end do end subroutine delete_skip +!> Delete the build directory including or excluding dependencies. subroutine cmd_clean(settings) - !> fpm clean called + !> Settings for the clean command. class(fpm_clean_settings), intent(in) :: settings - ! character(len=:), allocatable :: dir - ! type(string_t), allocatable :: files(:) - character(len=1) :: response + + character :: user_response + if (is_dir('build')) then - ! remove the entire build directory + ! Remove the entire build directory if (settings%clean_call) then - call os_delete_dir(settings%is_unix, 'build') - return + call os_delete_dir(os_is_unix(), 'build'); return end if - ! remove the build directory but skip dependencies + + ! Remove the build directory but skip dependencies if (settings%clean_skip) then - call delete_skip(settings%is_unix) - return + call delete_skip(os_is_unix()); return end if - ! prompt to remove the build directory but skip dependencies + + ! Prompt to remove the build directory but skip dependencies write(stdout, '(A)', advance='no') "Delete build, excluding dependencies (y/n)? " - read(stdin, '(A1)') response - if (lower(response) == 'y') call delete_skip(settings%is_unix) + read(stdin, '(A1)') user_response + if (lower(user_response) == 'y') call delete_skip(os_is_unix()) else write (stdout, '(A)') "fpm: No build directory found." end if diff --git a/src/fpm_command_line.f90 b/src/fpm_command_line.f90 index f1ced79308..306b79a535 100644 --- a/src/fpm_command_line.f90 +++ b/src/fpm_command_line.f90 @@ -23,7 +23,7 @@ !> ``fpm-help`` and ``fpm --list`` help pages below to make sure the help output !> is complete and consistent as well. module fpm_command_line -use fpm_environment, only : get_os_type, get_env, os_is_unix, & +use fpm_environment, only : get_os_type, get_env, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD use M_CLI2, only : set_args, lget, sget, unnamed, remaining, specified @@ -112,10 +112,8 @@ module fpm_command_line end type type, extends(fpm_cmd_settings) :: fpm_clean_settings - logical :: is_unix - character(len=:), allocatable :: calling_dir ! directory clean called from - logical :: clean_skip=.false. - logical :: clean_call=.false. + logical :: clean_skip = .false. + logical :: clean_call = .false. end type type, extends(fpm_build_settings) :: fpm_publish_settings @@ -217,7 +215,6 @@ subroutine get_command_line_settings(cmd_settings) character(len=4096) :: cmdarg integer :: i integer :: os - logical :: is_unix type(fpm_install_settings), allocatable :: install_settings type(version_t) :: version character(len=:), allocatable :: common_args, compiler_args, run_args, working_dir, & @@ -243,7 +240,6 @@ subroutine get_command_line_settings(cmd_settings) case (OS_UNKNOWN); os_type = "OS Type: Unknown" case default ; os_type = "OS Type: UNKNOWN" end select - is_unix = os_is_unix(os) ! Get current release version version = fpm_version() @@ -588,7 +584,7 @@ subroutine get_command_line_settings(cmd_settings) & build_tests=.true., & & name=names, & & runner=val_runner, & - & verbose=lget('verbose') ) + & verbose=lget('verbose')) case('update') call set_args(common_args // ' --fetch-only F --clean F', & @@ -613,10 +609,8 @@ subroutine get_command_line_settings(cmd_settings) allocate(fpm_clean_settings :: cmd_settings) call get_current_directory(working_dir, error) cmd_settings=fpm_clean_settings( & - & is_unix=is_unix, & - & calling_dir=working_dir, & & clean_skip=lget('skip'), & - clean_call=lget('all')) + & clean_call=lget('all')) case('publish') call set_args(common_args // compiler_args //'& From e9cddadcdc3a8b433fbe0298a39a6bb92a87ab3c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Jul 2023 16:06:31 +0200 Subject: [PATCH 288/304] add `preprocess_config` to the dependency struct --- src/fpm/manifest/dependency.f90 | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/src/fpm/manifest/dependency.f90 b/src/fpm/manifest/dependency.f90 index 75f5f5d10d..606c758897 100644 --- a/src/fpm/manifest/dependency.f90 +++ b/src/fpm/manifest/dependency.f90 @@ -32,6 +32,8 @@ module fpm_manifest_dependency use fpm_manifest_metapackages, only: metapackage_config_t, is_meta_package, new_meta_config, & metapackage_request_t, new_meta_request use fpm_versioning, only: version_t, new_version + use fpm_strings, only: string_t + use fpm_manifest_preprocess implicit none private @@ -55,6 +57,9 @@ module fpm_manifest_dependency !> The latest version is used if not specified. type(version_t), allocatable :: requested_version + !> Requested macros for the dependency + type(preprocess_config_t), allocatable :: preprocess(:) + !> Git descriptor type(git_target_t), allocatable :: git @@ -87,6 +92,8 @@ subroutine new_dependency(self, table, root, error) character(len=:), allocatable :: uri, value, requested_version + type(toml_table), pointer :: child + call check(table, error) if (allocated(error)) return @@ -136,6 +143,13 @@ subroutine new_dependency(self, table, root, error) if (allocated(error)) return end if + !> Get optional preprocessor directives + call get_value(table, "preprocess", child, requested=.false.) + if (associated(child)) then + call new_preprocessors(self%preprocess, child, error) + if (allocated(error)) return + end if + end subroutine new_dependency !> Check local schema for allowed entries @@ -158,7 +172,8 @@ subroutine check(table, error) "git", & "tag", & "branch", & - "rev" & + "rev", & + "preprocess" & & ] call table%get_key(name) @@ -170,6 +185,7 @@ subroutine check(table, error) end if call check_keys(table, valid_keys, error) + print *, 'check keys ',allocated(error) if (allocated(error)) return if (table%has_key("path") .and. table%has_key("git")) then From c480ca11af818ad33c656dd876905c87ef07ad0e Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Jul 2023 16:06:45 +0200 Subject: [PATCH 289/304] enable check for `child` node in toml, not only string values --- src/fpm/toml.f90 | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/src/fpm/toml.f90 b/src/fpm/toml.f90 index f8d8ea2420..71cb148330 100644 --- a/src/fpm/toml.f90 +++ b/src/fpm/toml.f90 @@ -123,6 +123,7 @@ subroutine check_keys(table, valid_keys, error) type(error_t), allocatable, intent(out) :: error type(toml_key), allocatable :: keys(:) + type(toml_table), pointer :: child character(:), allocatable :: name, value, valid_keys_string integer :: ikey, ivalid @@ -143,12 +144,18 @@ subroutine check_keys(table, valid_keys, error) end if ! Check if value can be mapped or else (wrong type) show error message with the error location. - ! Right now, it can only be mapped to a string, but this can be extended in the future. + ! Right now, it can only be mapped to a string or to a child node, but this can be extended in the future. call get_value(table, keys(ikey)%key, value) if (.not. allocated(value)) then - allocate (error) - error%message = "'"//name//"' has an invalid '"//keys(ikey)%key//"' entry." - return + + ! If value is not a string, check if it is a child node + call get_value(table, keys(ikey)%key, child) + + if (.not.associated(child)) then + allocate (error) + error%message = "'"//name//"' has an invalid '"//keys(ikey)%key//"' entry." + return + endif end if end do From 44076f4a0be0ed32abeebd7079544b0c6f5deece Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Jul 2023 16:07:01 +0200 Subject: [PATCH 290/304] create simple test program --- .../preprocess_per_dependency/app/main.f90 | 8 ++++++++ .../crate/utils/fpm.toml | 5 +++++ .../crate/utils/src/say_hello.f90 | 19 +++++++++++++++++++ .../preprocess_per_dependency/fpm.toml | 4 ++++ 4 files changed, 36 insertions(+) create mode 100644 example_packages/preprocess_per_dependency/app/main.f90 create mode 100644 example_packages/preprocess_per_dependency/crate/utils/fpm.toml create mode 100644 example_packages/preprocess_per_dependency/crate/utils/src/say_hello.f90 create mode 100644 example_packages/preprocess_per_dependency/fpm.toml diff --git a/example_packages/preprocess_per_dependency/app/main.f90 b/example_packages/preprocess_per_dependency/app/main.f90 new file mode 100644 index 0000000000..aed30cd33d --- /dev/null +++ b/example_packages/preprocess_per_dependency/app/main.f90 @@ -0,0 +1,8 @@ +program hello_fpm + use utils, only: say_hello + integer :: ierr + + call say_hello(ierr) + stop ierr ! ierr==0 if DEPENDENCY_MACRO is defined + +end program hello_fpm diff --git a/example_packages/preprocess_per_dependency/crate/utils/fpm.toml b/example_packages/preprocess_per_dependency/crate/utils/fpm.toml new file mode 100644 index 0000000000..f3c03f9934 --- /dev/null +++ b/example_packages/preprocess_per_dependency/crate/utils/fpm.toml @@ -0,0 +1,5 @@ +name = "utils" + +[preprocess] +[preprocess.cpp] +macros = ["X=1"] diff --git a/example_packages/preprocess_per_dependency/crate/utils/src/say_hello.f90 b/example_packages/preprocess_per_dependency/crate/utils/src/say_hello.f90 new file mode 100644 index 0000000000..5f333bab7e --- /dev/null +++ b/example_packages/preprocess_per_dependency/crate/utils/src/say_hello.f90 @@ -0,0 +1,19 @@ +module utils + + implicit none + +contains + + subroutine say_hello(ierr) + integer, intent(out) :: ierr + + ierr = -1 +#ifdef DEPENDENCY_MACRO + ierr = 0 +#endif + + print *, "Dependency macro ", merge(" IS","NOT",ierr==0)," defined" + + end subroutine say_hello + +end module utils diff --git a/example_packages/preprocess_per_dependency/fpm.toml b/example_packages/preprocess_per_dependency/fpm.toml new file mode 100644 index 0000000000..f9f2396e78 --- /dev/null +++ b/example_packages/preprocess_per_dependency/fpm.toml @@ -0,0 +1,4 @@ +name = "preprocess_cpp_deps" + +[dependencies] +utils = { path = "crate/utils" , preprocess.cpp="DEPENDENCY_MACRO" } From 5550f5ed54f13182c3f0b06a8f93aaed7cfd40a9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Jul 2023 16:34:44 +0200 Subject: [PATCH 291/304] verify cached preprocessors --- src/fpm.f90 | 21 ++++++++++++++- src/fpm/dependency.f90 | 16 ++++++++++++ src/fpm/manifest/dependency.f90 | 46 +++++++++++++++++++++------------ 3 files changed, 66 insertions(+), 17 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 129c4c95dc..8343ff615c 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -109,12 +109,31 @@ subroutine build_model(model, settings, package, error) end associate model%packages(i)%version = package%version%s() + !> Add this dependency's manifest macros + allocate(model%packages(i)%macros(0)) + if (allocated(dependency%preprocess)) then do j = 1, size(dependency%preprocess) if (dependency%preprocess(j)%name == "cpp") then if (.not. has_cpp) has_cpp = .true. if (allocated(dependency%preprocess(j)%macros)) then - model%packages(i)%macros = dependency%preprocess(j)%macros + model%packages(i)%macros = [model%packages(i)%macros, dependency%preprocess(j)%macros] + end if + else + write(stderr, '(a)') 'Warning: Preprocessor ' // package%preprocess(i)%name // & + ' is not supported; will ignore it' + end if + end do + end if + + !> Add this dependency's package-level macros + print *, 'dep preprocess? ',allocated(dep%preprocess),' nam,e=',dep%name + if (allocated(dep%preprocess)) then + do j = 1, size(dep%preprocess) + if (dep%preprocess(j)%name == "cpp") then + if (.not. has_cpp) has_cpp = .true. + if (allocated(dep%preprocess(j)%macros)) then + model%packages(i)%macros = [model%packages(i)%macros, dep%preprocess(j)%macros] end if else write(stderr, '(a)') 'Warning: Preprocessor ' // package%preprocess(i)%name // & diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index af6860a0ac..0b24adcecc 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -1187,6 +1187,8 @@ logical function dependency_has_changed(cached, manifest, verbosity, iunit) resu !> Log verbosity integer, intent(in) :: verbosity, iunit + integer :: ip + has_changed = .true. !> All the following entities must be equal for the dependency to not have changed @@ -1219,6 +1221,20 @@ logical function dependency_has_changed(cached, manifest, verbosity, iunit) resu else if (verbosity > 1) write (iunit, out_fmt) "PROJECT DIR has changed presence " end if + if (allocated(cached%preprocess) .eqv. allocated(manifest%preprocess)) then + if (size(cached%preprocess) /= size(manifest%preprocess)) then + if (verbosity > 1) write (iunit, out_fmt) "PREPROCESS has changed size" + return + end if + do ip=1,size(cached%preprocess) + if (cached%preprocess(ip) /= manifest%preprocess(ip)) then + if (verbosity > 1) write (iunit, out_fmt) "PREPROCESS config has changed" + return + end if + end do + else + if (verbosity > 1) write (iunit, out_fmt) "PREPROCESS has changed presence " + end if !> All checks passed: the two dependencies have no differences has_changed = .false. diff --git a/src/fpm/manifest/dependency.f90 b/src/fpm/manifest/dependency.f90 index 606c758897..2f61ed1336 100644 --- a/src/fpm/manifest/dependency.f90 +++ b/src/fpm/manifest/dependency.f90 @@ -100,6 +100,22 @@ subroutine new_dependency(self, table, root, error) call table%get_key(self%name) call get_value(table, "namespace", self%namespace) + call get_value(table, "v", requested_version) + if (allocated(requested_version)) then + if (.not. allocated(self%requested_version)) allocate (self%requested_version) + call new_version(self%requested_version, requested_version, error) + if (allocated(error)) return + end if + + !> Get optional preprocessor directives + call get_value(table, "preprocess", child, requested=.false.) + print *, 'has preprocess? ',associated(child) + if (associated(child)) then + call new_preprocessors(self%preprocess, child, error) + print *, 'size preprocess ',size(self%preprocess),' error? =',allocated(error) + if (allocated(error)) return + endif + call get_value(table, "path", uri) if (allocated(uri)) then if (get_os_type() == OS_WINDOWS) uri = windows_path(uri) @@ -135,21 +151,6 @@ subroutine new_dependency(self, table, root, error) return end if - call get_value(table, "v", requested_version) - - if (allocated(requested_version)) then - if (.not. allocated(self%requested_version)) allocate (self%requested_version) - call new_version(self%requested_version, requested_version, error) - if (allocated(error)) return - end if - - !> Get optional preprocessor directives - call get_value(table, "preprocess", child, requested=.false.) - if (associated(child)) then - call new_preprocessors(self%preprocess, child, error) - if (allocated(error)) return - end if - end subroutine new_dependency !> Check local schema for allowed entries @@ -163,6 +164,7 @@ subroutine check(table, error) character(len=:), allocatable :: name type(toml_key), allocatable :: list(:) + type(toml_table), pointer :: child !> List of valid keys for the dependency table. character(*), dimension(*), parameter :: valid_keys = [character(24) :: & @@ -185,7 +187,6 @@ subroutine check(table, error) end if call check_keys(table, valid_keys, error) - print *, 'check keys ',allocated(error) if (allocated(error)) return if (table%has_key("path") .and. table%has_key("git")) then @@ -218,6 +219,18 @@ subroutine check(table, error) return end if + ! Check preprocess key + if (table%has_key('preprocess')) then + + call get_value(table, 'preprocess', child) + + if (.not.associated(child)) then + call syntax_error(error, "Dependency '"//name//"' has invalid 'preprocess' entry") + return + end if + + end if + end subroutine check !> Construct new dependency array from a TOML data structure @@ -279,6 +292,7 @@ subroutine new_dependencies(deps, table, root, meta, error) ! Parse as a standard dependency is_meta(idep) = .false. + print *, 'new dependency ',all_deps(idep)%name call new_dependency(all_deps(idep), node, root, error) if (allocated(error)) return From 28c3fd9eba7bc4fc4edbdf8831c29f75430fdef2 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Jul 2023 16:51:18 +0200 Subject: [PATCH 292/304] compare preprocessing configs in the cached manifest --- src/fpm/dependency.f90 | 4 ++- src/fpm/manifest/preprocess.f90 | 51 +++++++++++++++++++++++++++++++-- 2 files changed, 52 insertions(+), 3 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 0b24adcecc..86a90c5a98 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -63,6 +63,7 @@ module fpm_dependency use fpm_git, only: git_target_revision, git_target_default, git_revision, operator(==) use fpm_manifest, only: package_config_t, dependency_config_t, get_package_data use fpm_manifest_dependency, only: manifest_has_changed + use fpm_manifest_preprocess, only: operator(==) use fpm_strings, only: string_t, operator(.in.) use fpm_toml, only: toml_table, toml_key, toml_error, toml_serialize, & get_value, set_value, add_table, toml_load, toml_stat @@ -1227,13 +1228,14 @@ logical function dependency_has_changed(cached, manifest, verbosity, iunit) resu return end if do ip=1,size(cached%preprocess) - if (cached%preprocess(ip) /= manifest%preprocess(ip)) then + if (.not.(cached%preprocess(ip) == manifest%preprocess(ip))) then if (verbosity > 1) write (iunit, out_fmt) "PREPROCESS config has changed" return end if end do else if (verbosity > 1) write (iunit, out_fmt) "PREPROCESS has changed presence " + return end if !> All checks passed: the two dependencies have no differences diff --git a/src/fpm/manifest/preprocess.f90 b/src/fpm/manifest/preprocess.f90 index 538652c29a..3f9754725a 100644 --- a/src/fpm/manifest/preprocess.f90 +++ b/src/fpm/manifest/preprocess.f90 @@ -17,7 +17,7 @@ module fpm_manifest_preprocess implicit none private - public :: preprocess_config_t, new_preprocess_config, new_preprocessors + public :: preprocess_config_t, new_preprocess_config, new_preprocessors, operator(==) !> Configuration meta data for a preprocessor type :: preprocess_config_t @@ -41,6 +41,10 @@ module fpm_manifest_preprocess end type preprocess_config_t + interface operator(==) + module procedure preprocess_is_same + end interface + contains !> Construct a new preprocess configuration from TOML data structure @@ -154,7 +158,7 @@ subroutine info(self, unit, verbosity) pr = 1 end if - if (pr < 1) return + if (pr < 1) return write(unit, fmt) "Preprocessor" if (allocated(self%name)) then @@ -181,4 +185,47 @@ subroutine info(self, unit, verbosity) end subroutine info + logical function preprocess_is_same(this,that) + class(preprocess_config_t), intent(in) :: this + class(preprocess_config_t), intent(in) :: that + + integer :: istr + + preprocess_is_same = .false. + + select type (other=>that) + type is (preprocess_config_t) + if (allocated(this%name).neqv.allocated(other%name)) return + if (allocated(this%name)) then + if (.not.(this%name==other%name)) return + endif + if (.not.(allocated(this%suffixes).eqv.allocated(other%suffixes))) return + if (allocated(this%suffixes)) then + do istr=1,size(this%suffixes) + if (.not.(this%suffixes(istr)%s==other%suffixes(istr)%s)) return + end do + end if + if (.not.(allocated(this%directories).eqv.allocated(other%directories))) return + if (allocated(this%directories)) then + do istr=1,size(this%directories) + if (.not.(this%directories(istr)%s==other%directories(istr)%s)) return + end do + end if + if (.not.(allocated(this%macros).eqv.allocated(other%macros))) return + if (allocated(this%macros)) then + do istr=1,size(this%macros) + if (.not.(this%macros(istr)%s==other%macros(istr)%s)) return + end do + end if + + class default + ! Not the same type + return + end select + + !> All checks passed! + preprocess_is_same = .true. + + end function preprocess_is_same + end module fpm_manifest_preprocess From 011877ff4e52990b5c3823d2651eacb794066587 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Jul 2023 16:51:33 +0200 Subject: [PATCH 293/304] fix example macro input --- example_packages/preprocess_per_dependency/fpm.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/example_packages/preprocess_per_dependency/fpm.toml b/example_packages/preprocess_per_dependency/fpm.toml index f9f2396e78..4730973ab1 100644 --- a/example_packages/preprocess_per_dependency/fpm.toml +++ b/example_packages/preprocess_per_dependency/fpm.toml @@ -1,4 +1,4 @@ name = "preprocess_cpp_deps" [dependencies] -utils = { path = "crate/utils" , preprocess.cpp="DEPENDENCY_MACRO" } +utils = { path = "crate/utils" , preprocess.cpp.macros=["DEPENDENCY_MACRO"] } From e29f3943c243b4e13316b32199d48bf773faee06 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Jul 2023 16:53:28 +0200 Subject: [PATCH 294/304] add package test to CI --- ci/run_tests.sh | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ci/run_tests.sh b/ci/run_tests.sh index 987b282449..d84a00f1c5 100755 --- a/ci/run_tests.sh +++ b/ci/run_tests.sh @@ -150,6 +150,10 @@ pushd preprocess_cpp_deps "$fpm" build popd +pushd preprocess_per_dependency +"$fpm" run +popd + pushd preprocess_hello "$fpm" build popd From 826b1825be45d348d67fcea7f395b7d527b9ec76 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Jul 2023 17:15:14 +0200 Subject: [PATCH 295/304] fix unallocated preprocess in test --- src/fpm/dependency.f90 | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/fpm/dependency.f90 b/src/fpm/dependency.f90 index 86a90c5a98..52e5c6ec12 100644 --- a/src/fpm/dependency.f90 +++ b/src/fpm/dependency.f90 @@ -1223,16 +1223,18 @@ logical function dependency_has_changed(cached, manifest, verbosity, iunit) resu if (verbosity > 1) write (iunit, out_fmt) "PROJECT DIR has changed presence " end if if (allocated(cached%preprocess) .eqv. allocated(manifest%preprocess)) then - if (size(cached%preprocess) /= size(manifest%preprocess)) then - if (verbosity > 1) write (iunit, out_fmt) "PREPROCESS has changed size" - return - end if - do ip=1,size(cached%preprocess) - if (.not.(cached%preprocess(ip) == manifest%preprocess(ip))) then - if (verbosity > 1) write (iunit, out_fmt) "PREPROCESS config has changed" + if (allocated(cached%preprocess)) then + if (size(cached%preprocess) /= size(manifest%preprocess)) then + if (verbosity > 1) write (iunit, out_fmt) "PREPROCESS has changed size" return - end if - end do + end if + do ip=1,size(cached%preprocess) + if (.not.(cached%preprocess(ip) == manifest%preprocess(ip))) then + if (verbosity > 1) write (iunit, out_fmt) "PREPROCESS config has changed" + return + end if + end do + endif else if (verbosity > 1) write (iunit, out_fmt) "PREPROCESS has changed presence " return From 3df03c22535aa0270272f4409c223cc1c8a916b7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 4 Jul 2023 17:19:21 +0200 Subject: [PATCH 296/304] cleanup cleanup --- src/fpm.f90 | 1 - src/fpm/manifest/dependency.f90 | 3 --- test/fpm_test/test_package_dependencies.f90 | 1 - 3 files changed, 5 deletions(-) diff --git a/src/fpm.f90 b/src/fpm.f90 index 8343ff615c..0a2712e612 100644 --- a/src/fpm.f90 +++ b/src/fpm.f90 @@ -127,7 +127,6 @@ subroutine build_model(model, settings, package, error) end if !> Add this dependency's package-level macros - print *, 'dep preprocess? ',allocated(dep%preprocess),' nam,e=',dep%name if (allocated(dep%preprocess)) then do j = 1, size(dep%preprocess) if (dep%preprocess(j)%name == "cpp") then diff --git a/src/fpm/manifest/dependency.f90 b/src/fpm/manifest/dependency.f90 index 2f61ed1336..de4f104db9 100644 --- a/src/fpm/manifest/dependency.f90 +++ b/src/fpm/manifest/dependency.f90 @@ -109,10 +109,8 @@ subroutine new_dependency(self, table, root, error) !> Get optional preprocessor directives call get_value(table, "preprocess", child, requested=.false.) - print *, 'has preprocess? ',associated(child) if (associated(child)) then call new_preprocessors(self%preprocess, child, error) - print *, 'size preprocess ',size(self%preprocess),' error? =',allocated(error) if (allocated(error)) return endif @@ -292,7 +290,6 @@ subroutine new_dependencies(deps, table, root, meta, error) ! Parse as a standard dependency is_meta(idep) = .false. - print *, 'new dependency ',all_deps(idep)%name call new_dependency(all_deps(idep), node, root, error) if (allocated(error)) return diff --git a/test/fpm_test/test_package_dependencies.f90 b/test/fpm_test/test_package_dependencies.f90 index 4f645750b5..0a5877a172 100644 --- a/test/fpm_test/test_package_dependencies.f90 +++ b/test/fpm_test/test_package_dependencies.f90 @@ -334,7 +334,6 @@ subroutine test_non_updated_dependencies(error) return end if - ! Test that dependency 3 is flagged as "not update" if (manifest_deps%dep(3)%update) then call test_failed(error, "Updated dependency (git rev) detected, should not be") From 69d3ea74a56e17df67c1d80ee2cbe84ceb89e7a6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 7 Jul 2023 15:03:17 +0200 Subject: [PATCH 297/304] fix unallocated targets array --- src/fpm_targets.f90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index bc31f1594b..df0d58810f 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -198,15 +198,14 @@ subroutine build_target_list(targets,model) character(:), allocatable :: exe_dir, compile_flags logical :: with_lib + ! Initialize targets + allocate(targets(0)) + ! Check for empty build (e.g. header-only lib) n_source = sum([(size(model%packages(j)%sources), & j=1,size(model%packages))]) - if (n_source < 1) then - allocate(targets(0)) - return - end if - + if (n_source < 1) return with_lib = any([((model%packages(j)%sources(i)%unit_scope == FPM_SCOPE_LIB, & i=1,size(model%packages(j)%sources)), & @@ -826,7 +825,7 @@ subroutine resolve_target_linking(targets, model) if (.not.allocated(target%compile_flags)) allocate(character(len=0) :: target%compile_flags) target%compile_flags = target%compile_flags//' ' - + select case (target%target_type) case (FPM_TARGET_C_OBJECT) target%compile_flags = target%compile_flags//model%c_compile_flags @@ -835,7 +834,7 @@ subroutine resolve_target_linking(targets, model) case default target%compile_flags = target%compile_flags//model%fortran_compile_flags & & // get_feature_flags(model%compiler, target%features) - end select + end select !> Get macros as flags. target%compile_flags = target%compile_flags // get_macros(model%compiler%id, & From ce9299636fca6fb50850ebf4cb6189ba2f3e3cc3 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Wed, 9 Aug 2023 08:17:49 +0200 Subject: [PATCH 298/304] remove `/en/` locale from paths --- README.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index a3e3be3f77..3670cede53 100644 --- a/README.md +++ b/README.md @@ -33,10 +33,10 @@ non-Fortran related package manager. **Website: ** -## [Download](https://fpm.fortran-lang.org/en/install/index.html) +## [Download](https://fpm.fortran-lang.org/install/index.html) Fpm is available on many platforms and through multiple package managers, see our Documentation -webpage for a list of **[All Supported Installations](https://fpm.fortran-lang.org/en/install/index.html)**. +webpage for a list of **[All Supported Installations](https://fpm.fortran-lang.org/install/index.html)**. The easiest installation routes are shown below. @@ -86,9 +86,9 @@ Binary distributions are available for MacOS 11 (Catalina) and 12 (Big Sur) for Fpm should be available and functional after those steps. For more details checkout the tap [here](https://github.com/fortran-lang/homebrew-fortran). -## [Get started](https://fpm.fortran-lang.org/en/tutorial/index.html) +## [Get started](https://fpm.fortran-lang.org/tutorial/index.html) -**Follow our [Quickstart Tutorial](https://fpm.fortran-lang.org/en/tutorial/hello-fpm.html) to get familiar with fpm**. +**Follow our [Quickstart Tutorial](https://fpm.fortran-lang.org/tutorial/hello-fpm.html) to get familiar with fpm**. ### Start a new project @@ -118,7 +118,7 @@ arguments can also be passed to the executable(s) or test(s) with the option `-- some arguments`. See additional instructions in the [Packaging guide](PACKAGING.md) or -the [manifest reference](https://fpm.fortran-lang.org/en/spec/manifest.html). +the [manifest reference](https://fpm.fortran-lang.org/spec/manifest.html).