From c9927a9bfe4b7db7d1c639e2ce4eb849e79f5554 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 08:56:27 +0200 Subject: [PATCH 01/46] add hdf5 table --- src/fpm/manifest/meta.f90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/fpm/manifest/meta.f90 b/src/fpm/manifest/meta.f90 index 3719067030..d942a25a16 100644 --- a/src/fpm/manifest/meta.f90 +++ b/src/fpm/manifest/meta.f90 @@ -48,6 +48,9 @@ module fpm_manifest_metapackages !> fortran-lang minpack type(metapackage_request_t) :: minpack + + !> HDF5 + type(metapackage_request_t) :: hdf5 end type metapackage_config_t @@ -196,6 +199,9 @@ subroutine new_meta_config(self, table, meta_allowed, error) call new_meta_request(self%mpi, "mpi", table, meta_allowed, error) if (allocated(error)) return + + call new_meta_request(self%hdf5, "hdf5", table, meta_allowed, error) + if (allocated(error)) return end subroutine new_meta_config @@ -208,7 +214,7 @@ logical function is_meta_package(key) select case (key) !> Supported metapackages - case ("openmp","stdlib","mpi","minpack") + case ("openmp","stdlib","mpi","minpack","hdf5") is_meta_package = .true. case default From 252b0eec9feaf882c6057099909fb7ff8757947b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 08:57:47 +0200 Subject: [PATCH 02/46] add `hdf5` table --- src/fpm_meta.f90 | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 3265b26e47..1590f2af8a 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -9,6 +9,7 @@ !> !> - OpenMP !> - MPI +!> - HDF5 !> - fortran-lang stdlib !> - fortran-lang minpack !> @@ -454,13 +455,12 @@ subroutine resolve_metapackage_model(model,package,settings,error) if (allocated(error)) return endif - ! stdlib + ! minpack 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!' @@ -472,6 +472,12 @@ subroutine resolve_metapackage_model(model,package,settings,error) if (allocated(error)) return endif + ! hdf5 + if (package%meta%hdf5%on) then + call add_metapackage_model(model,package,settings,"hdf5",error) + if (allocated(error)) return + endif + end subroutine resolve_metapackage_model !> Initialize MPI metapackage for the current system From 6dba26e113f7f2015ff1dc1d60c2d1cf1fb68ccc Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 09:31:43 +0200 Subject: [PATCH 03/46] test for `pkg-config` --- src/fpm_meta.f90 | 152 ++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 137 insertions(+), 15 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 1590f2af8a..8ba36031c0 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -171,6 +171,7 @@ subroutine init_from_name(this,name,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("hdf5"); call init_hdf5 (this,compiler,error) case default call syntax_error(error, "Package "//name//" is not supported in [metapackages]") return @@ -1273,8 +1274,107 @@ subroutine assert_mpi_wrappers(wrappers,compiler,verbose) end subroutine assert_mpi_wrappers +!> Check whether pkg-config is available on the local system +logical function assert_pkg_config() + + integer :: exitcode + logical :: success + type(string_t) :: log + + call run_wrapper(wrapper=string_t('pkg-config'),args=[string_t('-h')], & + exitcode=exitcode,cmd_success=success,screen_output=log) + + print *, 'exitcode ',exitcode + print *, 'success ',success + print *, 'log: ' + print *, log%s + + + assert_pkg_config = exitcode==0 .and. success + +end function assert_pkg_config + !> Simple call to execute_command_line involving one mpi* wrapper -subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_output) +subroutine run_pkg_config(args,verbose,exitcode,cmd_success,screen_output) + 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=.false. + 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 = 'pkg-config' + + 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 + + if (echo_local) 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 pkg-config run') + endif + + end if + +end subroutine run_pkg_config + +!> Simple call to execute_command_line involving one mpi* wrapper +subroutine run_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 @@ -1360,7 +1460,7 @@ subroutine run_mpi_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_outp end if -end subroutine run_mpi_wrapper +end subroutine run_wrapper !> Get MPI library type from the wrapper command. Currently, only OpenMPI is supported integer function which_mpi_library(wrapper,compiler,verbose) @@ -1377,7 +1477,7 @@ integer function which_mpi_library(wrapper,compiler,verbose) if (len_trim(wrapper)<=0) return ! Run mpi wrapper first - call run_mpi_wrapper(wrapper,verbose=verbose,cmd_success=is_mpi_wrapper) + call run_wrapper(wrapper,verbose=verbose,cmd_success=is_mpi_wrapper) if (is_mpi_wrapper) then @@ -1389,7 +1489,7 @@ integer function which_mpi_library(wrapper,compiler,verbose) ! Attempt to decipher which library this wrapper comes from. ! OpenMPI responds to '--showme' calls - call run_mpi_wrapper(wrapper,[string_t('--showme')],verbose,& + call run_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 @@ -1397,7 +1497,7 @@ integer function which_mpi_library(wrapper,compiler,verbose) endif ! MPICH responds to '-show' calls - call run_mpi_wrapper(wrapper,[string_t('-show')],verbose,& + call run_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 @@ -1438,7 +1538,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) return end select - call run_mpi_wrapper(wrapper,[cmdstr],verbose=verbose, & + call run_wrapper(wrapper,[cmdstr],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) if (stat/=0 .or. .not.success) then @@ -1464,7 +1564,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) return end select - call run_mpi_wrapper(wrapper,[cmdstr],verbose=verbose, & + call run_wrapper(wrapper,[cmdstr],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) if (stat/=0 .or. .not.success) then @@ -1501,7 +1601,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) return end select - call run_mpi_wrapper(wrapper,[cmdstr],verbose=verbose, & + call run_wrapper(wrapper,[cmdstr],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) if (stat/=0 .or. .not.success) then @@ -1531,7 +1631,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('--showme:libdirs')],verbose=verbose, & + call run_wrapper(wrapper,[string_t('--showme:libdirs')],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) if (stat/=0 .or. .not.success) then @@ -1552,7 +1652,7 @@ 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, & + call run_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') @@ -1572,7 +1672,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) case (MPI_TYPE_OPENMPI) ! --showme:command returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('--showme:version')],verbose=verbose, & + call run_wrapper(wrapper,[string_t('--showme:version')],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) if (stat/=0 .or. .not.success) then @@ -1587,12 +1687,12 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) !> 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, & + call run_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, & + call run_wrapper(wrapper,[string_t('-v')],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) call remove_newline_characters(screen) endif @@ -1600,7 +1700,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) ! Third option: mpiexec --version if (stat/=0 .or. .not.success) then cmdstr = string_t('mpiexec --version') - call run_mpi_wrapper(cmdstr,verbose=verbose, & + call run_wrapper(cmdstr,verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) endif @@ -1612,7 +1712,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) case (MPI_TYPE_INTEL) ! --showme:command returns the build command of this wrapper - call run_mpi_wrapper(wrapper,[string_t('-v')],verbose=verbose, & + call run_wrapper(wrapper,[string_t('-v')],verbose=verbose, & exitcode=stat,cmd_success=success,screen_output=screen) if (stat/=0 .or. .not.success) then @@ -1771,5 +1871,27 @@ subroutine filter_link_arguments(compiler,command) end subroutine filter_link_arguments +!> Initialize HDF5 metapackage for the current system +subroutine init_hdf5(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) + + !> Assert pkg-config is installed + if (.not.assert_pkg_config()) then + call fatal_error(error,'hdf5 metapackage requires pkg-config') + return + end if + + !> minpack is queried as a dependency from the official repository + this%has_dependencies = .true. + + call fatal_error(error,'hdf5 metapackage not finished') + + +end subroutine init_hdf5 end module fpm_meta From f321c2be2347d759ff668b6933674c774267d2a9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 09:47:57 +0200 Subject: [PATCH 04/46] pkg-config: query version --- src/fpm_meta.f90 | 129 ++++++++++++++++------------------------------- 1 file changed, 44 insertions(+), 85 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 8ba36031c0..447f0876d1 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1284,95 +1284,10 @@ logical function assert_pkg_config() call run_wrapper(wrapper=string_t('pkg-config'),args=[string_t('-h')], & exitcode=exitcode,cmd_success=success,screen_output=log) - print *, 'exitcode ',exitcode - print *, 'success ',success - print *, 'log: ' - print *, log%s - - assert_pkg_config = exitcode==0 .and. success end function assert_pkg_config -!> Simple call to execute_command_line involving one mpi* wrapper -subroutine run_pkg_config(args,verbose,exitcode,cmd_success,screen_output) - 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=.false. - 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 = 'pkg-config' - - 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 - - if (echo_local) 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 pkg-config run') - endif - - end if - -end subroutine run_pkg_config - !> Simple call to execute_command_line involving one mpi* wrapper subroutine run_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_output) type(string_t), intent(in) :: wrapper @@ -1871,11 +1786,46 @@ subroutine filter_link_arguments(compiler,command) end subroutine filter_link_arguments +!> Query pkg-config for information +type(string_t) function pkgcfg_query(package,command,error) result(screen) + character(*), intent(in) :: package,command + type(error_t), allocatable, intent(out) :: error + + integer :: exitcode + logical :: success + type(string_t) :: log + + select case (command) + + case ('version') + + call run_wrapper(wrapper=string_t('pkg-config'), & + args=[string_t(package),string_t('--modversion')], & + exitcode=exitcode,cmd_success=success,screen_output=log) + + if (success .and. exitcode==0) then + call remove_newline_characters(log) + screen = log + else + screen = string_t("") + end if + + case default + + call fatal_error(error, 'Internal error: invalid pkg-config query '//command) + return + + end select + +end function pkgcfg_query + !> Initialize HDF5 metapackage for the current system subroutine init_hdf5(this,compiler,error) class(metapackage_t), intent(inout) :: this type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error + + type(string_t) :: log !> Cleanup call destroy(this) @@ -1885,6 +1835,15 @@ subroutine init_hdf5(this,compiler,error) call fatal_error(error,'hdf5 metapackage requires pkg-config') return end if + + !> Get version + log = pkgcfg_query('hdf5','version',error) + if (allocated(error)) return + allocate(this%version) + call new_version(this%version,log%s,error) + if (allocated(error)) return + + print *, 'version ',this%version%s() !> minpack is queried as a dependency from the official repository this%has_dependencies = .true. From 58ca795c70688352c3ac1cc241f6d73fec80450b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 10:16:35 +0200 Subject: [PATCH 05/46] pkg-config: query library flags --- src/fpm_meta.f90 | 112 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 83 insertions(+), 29 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 447f0876d1..dbd661814f 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1786,38 +1786,74 @@ subroutine filter_link_arguments(compiler,command) end subroutine filter_link_arguments -!> Query pkg-config for information -type(string_t) function pkgcfg_query(package,command,error) result(screen) - character(*), intent(in) :: package,command +!> Get package version from pkg-config +type(string_t) function pkgcfg_get_version(package,error) result(screen) + + !> Package name + character(*), intent(in) :: package + + !> Error handler type(error_t), allocatable, intent(out) :: error integer :: exitcode logical :: success type(string_t) :: log + + call run_wrapper(wrapper=string_t('pkg-config'), & + args=[string_t(package),string_t('--modversion')], & + exitcode=exitcode,cmd_success=success,screen_output=log) - select case (command) - - case ('version') - - call run_wrapper(wrapper=string_t('pkg-config'), & - args=[string_t(package),string_t('--modversion')], & - exitcode=exitcode,cmd_success=success,screen_output=log) - - if (success .and. exitcode==0) then - call remove_newline_characters(log) - screen = log - else - screen = string_t("") - end if - - case default - - call fatal_error(error, 'Internal error: invalid pkg-config query '//command) - return - - end select + if (success .and. exitcode==0) then + call remove_newline_characters(log) + screen = log + else + screen = string_t("") + end if + +end function pkgcfg_get_version + +!> Get package libraries from pkg-config +function pkgcfg_get_libs(package,error) result(libraries) + + !> Package name + character(*), intent(in) :: package + + !> Error handler + type(error_t), allocatable, intent(out) :: error + + !> A list of libraries + type(string_t), allocatable :: libraries(:) -end function pkgcfg_query + integer :: exitcode,nlib,i + logical :: success + character(len=:), allocatable :: tokens(:) + type(string_t) :: log + + call run_wrapper(wrapper=string_t('pkg-config'), & + args=[string_t(package),string_t('--libs')], & + exitcode=exitcode,cmd_success=success,screen_output=log) + + if (success .and. exitcode==0) then + + call remove_newline_characters(log) + + ! Split all arguments + tokens = shlex_split(log%s) + + nlib = size(tokens) + allocate(libraries(nlib)) + do i=1,nlib + libraries(i) = string_t(tokens(i)) + end do + + else + + allocate(libraries(0)) + call fatal_error(error,'cannot get <'//package//'> libraries from pkg-config') + + end if + +end function pkgcfg_get_libs !> Initialize HDF5 metapackage for the current system subroutine init_hdf5(this,compiler,error) @@ -1825,10 +1861,14 @@ subroutine init_hdf5(this,compiler,error) type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error + integer :: i type(string_t) :: log + type(string_t), allocatable :: libs(:) !> Cleanup call destroy(this) + allocate(this%link_libs(0),this%incl_dirs(0),this%external_modules(0)) + this%link_flags = string_t("") !> Assert pkg-config is installed if (.not.assert_pkg_config()) then @@ -1837,16 +1877,30 @@ subroutine init_hdf5(this,compiler,error) end if !> Get version - log = pkgcfg_query('hdf5','version',error) + log = pkgcfg_get_version('hdf5',error) if (allocated(error)) return allocate(this%version) call new_version(this%version,log%s,error) if (allocated(error)) return - print *, 'version ',this%version%s() + !> Get libraries + libs = pkgcfg_get_libs('hdf5',error) + if (allocated(error)) return + do i=1,size(libs) + + if (str_begins_with_str(libs(i)%s,'-l')) then + this%has_link_libraries = .true. + this%link_libs = [this%link_libs, string_t(libs(i)%s(3:))] + + else ! -L and other: concatenate + this%has_link_flags = .true. + this%link_flags = string_t(trim(this%link_flags%s)//' '//libs(i)%s) + end if + end do + + + ! [TODO] manually add High-Level libraries (HL) - !> minpack is queried as a dependency from the official repository - this%has_dependencies = .true. call fatal_error(error,'hdf5 metapackage not finished') From 5cbd448b1d7230309dcbc2365ecfde67b9fccc81 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 10:26:35 +0200 Subject: [PATCH 06/46] search hdf5 packages: hdf5, hdf5-serial --- src/fpm_meta.f90 | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index dbd661814f..2506a22118 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1812,6 +1812,26 @@ type(string_t) function pkgcfg_get_version(package,error) result(screen) end function pkgcfg_get_version +!> Check if pkgcfg has package +logical function pkgcfg_has_package(name) result(success) + + !> Package name + character(*), intent(in) :: name + + integer :: exitcode + logical :: cmdok + type(string_t) :: log + + call run_wrapper(wrapper=string_t('pkg-config'), & + args=[string_t(name),string_t('--exists')], & + exitcode=exitcode,cmd_success=cmdok,screen_output=log) + + !> pkg-config --exists returns 0 only if the package exists + success = cmdok .and. exitcode==0 + +end function pkgcfg_has_package + + !> Get package libraries from pkg-config function pkgcfg_get_libs(package,error) result(libraries) @@ -1862,8 +1882,11 @@ subroutine init_hdf5(this,compiler,error) type(error_t), allocatable, intent(out) :: error integer :: i + logical :: s type(string_t) :: log type(string_t), allocatable :: libs(:) + character(len=:), allocatable :: name + character(*), parameter :: candidates(2) = [character(10) :: 'hdf5','hdf5-serial'] !> Cleanup call destroy(this) @@ -1876,6 +1899,19 @@ subroutine init_hdf5(this,compiler,error) return end if + !> Find pkg-config package file (parallel first) + name = 'ERROR' + do i=1,size(candidates) + if (pkgcfg_has_package(trim(candidates(i)))) then + name = trim(candidates(i)) + exit + end if + end do + if (name=='ERROR') then + call fatal_error(error,'pkg-config could not find a suitable hdf5 package.') + return + end if + !> Get version log = pkgcfg_get_version('hdf5',error) if (allocated(error)) return From 71a2ca37ca8616b5201ad6dc608b1af69d3c0147 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 10:59:44 +0200 Subject: [PATCH 07/46] search hdf5 packages in pkg-config list --- src/fpm_meta.f90 | 89 +++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 80 insertions(+), 9 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 2506a22118..c3413a368c 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1875,6 +1875,63 @@ function pkgcfg_get_libs(package,error) result(libraries) end function pkgcfg_get_libs +!> Return whole list of available pkg-cfg packages +function pkgcfg_list_all(error,descriptions) result(modules) + + !> Error handler + type(error_t), allocatable, intent(out) :: error + + !> A list of all available packages + type(string_t), allocatable :: modules(:) + + !> An optional list of package descriptions + type(string_t), optional, allocatable, intent(out) :: descriptions(:) + + integer :: exitcode,i,spc + logical :: success + character(len=:), allocatable :: lines(:) + type(string_t) :: log + type(string_t), allocatable :: mods(:),descr(:) + character(*), parameter :: CRLF = achar(13)//new_line('a') + + call run_wrapper(wrapper=string_t('pkg-config'), & + args=[string_t('--list-all')], & + exitcode=exitcode,cmd_success=success,screen_output=log) + + if (.not.(success .and. exitcode==0)) then + call fatal_error(error,'cannot get pkg-config modules') + allocate(modules(0)) + return + end if + + !> Extract list + call split(log%s,lines,CRLF) + allocate(mods(size(lines)),descr(size(lines))) + + do i=1,size(lines) + + ! Module names have no spaces + spc = index(lines(i),' ') + + if (spc>0) then + + mods(i) = string_t(trim(adjustl(lines(i)(1:spc)))) + descr(i) = string_t(trim(adjustl(lines(i)(spc+1:)))) + + else + + mods(i) = string_t(trim(adjustl(lines(i)))) + descr(i) = string_t("") + + end if + + end do + + call move_alloc(from=mods,to=modules) + if (present(descriptions)) call move_alloc(from=descr,to=descriptions) + +end function pkgcfg_list_all + !> Initialize HDF5 metapackage for the current system subroutine init_hdf5(this,compiler,error) class(metapackage_t), intent(inout) :: this @@ -1884,9 +1941,10 @@ subroutine init_hdf5(this,compiler,error) integer :: i logical :: s type(string_t) :: log - type(string_t), allocatable :: libs(:) + type(string_t), allocatable :: libs(:),modules(:) character(len=:), allocatable :: name - character(*), parameter :: candidates(2) = [character(10) :: 'hdf5','hdf5-serial'] + character(*), parameter :: candidates(5) = & + [character(15) :: 'hdf5_hl_fortran','hdf5_fortran','hdf5_hl','hdf5','hdf5-serial'] !> Cleanup call destroy(this) @@ -1899,28 +1957,40 @@ subroutine init_hdf5(this,compiler,error) return end if - !> Find pkg-config package file (parallel first) - name = 'ERROR' + !> Find pkg-config package file by priority + name = 'NOT_FOUND' do i=1,size(candidates) if (pkgcfg_has_package(trim(candidates(i)))) then name = trim(candidates(i)) exit end if end do - if (name=='ERROR') then + + !> some distros put hdf5-1.2.3.pc with version number in .pc filename. + if (name=='NOT_FOUND') then + modules = pkgcfg_list_all(error) + do i=1,size(modules) + if (str_begins_with_str(modules(i)%s,'hdf5')) then + name = modules(i)%s + exit + end if + end do + end if + + if (name=='NOT_FOUND') then call fatal_error(error,'pkg-config could not find a suitable hdf5 package.') return end if - + !> Get version - log = pkgcfg_get_version('hdf5',error) + log = pkgcfg_get_version(name,error) if (allocated(error)) return allocate(this%version) call new_version(this%version,log%s,error) if (allocated(error)) return !> Get libraries - libs = pkgcfg_get_libs('hdf5',error) + libs = pkgcfg_get_libs(name,error) if (allocated(error)) return do i=1,size(libs) @@ -1934,8 +2004,9 @@ subroutine init_hdf5(this,compiler,error) end if end do + ! [TODO] manually add High-Level API libraries (HL) + - ! [TODO] manually add High-Level libraries (HL) call fatal_error(error,'hdf5 metapackage not finished') From 36337dde529f0e7a8aa685ceed1d18e077d91a58 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 11:32:54 +0200 Subject: [PATCH 08/46] implement `c_setenv` --- src/fpm_environment.f90 | 68 +++++++++++++++++++++++++++++++++++++++++ src/fpm_os.c | 9 ++++++ 2 files changed, 77 insertions(+) diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index aba65e77bd..bc0503a325 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -6,14 +6,17 @@ module fpm_environment use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, & & stdout=>output_unit, & & stderr=>error_unit + use,intrinsic :: iso_c_binding, only: c_char,c_int,c_null_char use fpm_error, only : fpm_stop implicit none private public :: get_os_type public :: os_is_unix public :: get_env + public :: set_env public :: get_command_arguments_quoted public :: separator + public :: OS_NAME integer, parameter, public :: OS_UNKNOWN = 0 @@ -338,4 +341,69 @@ function separator() result(sep) endif !*ifort_bug*!sep_cache=sep end function separator + +!> Set an environment variable for the current environment using the C standard library + +logical function set_env(name,value,overwrite) + + !> Variable name + character(*), intent(in) :: name + + !> Variable value + character(*), intent(in) :: value + + !> Should a former value be overwritten? default = .true. + logical, optional, intent(in) :: overwrite + + ! Local variables + logical :: can_overwrite + integer(c_int) :: cover,cerr + character(kind=c_char,len=1), allocatable :: c_value(:),c_name(:) + + interface + integer(c_int) function c_setenv(envname, envval, overwrite) bind(C,name="c_setenv") + import c_int, c_char + implicit none + !> Pointer to the name string + character(kind=c_char,len=1), intent(in) :: envname(*) + !> Pointer to the value string + character(kind=c_char,len=1), intent(in) :: envval(*) + !> Overwrite option + integer(c_int), intent(in), value :: overwrite + end function c_setenv + end interface + + !> Overwrite setting + can_overwrite = .true. + if (present(overwrite)) can_overwrite = overwrite + cover = merge(1_c_int,0_c_int,can_overwrite) + + !> C strings + call f2cs(name,c_name) + call f2cs(value,c_value) + + !> Call setenv + cerr = c_setenv(c_name,c_value,cover) + + set_env = cerr==0_c_int + + contains + + pure subroutine f2cs(f,c) + use iso_c_binding, only: c_char,c_null_char + character(*), intent(in) :: f + character(len=1,kind=c_char), allocatable, intent(out) :: c(:) + + integer :: lf,i + + lf = len(f) + allocate(c(lf+1)) + c(lf+1) = c_null_char + forall(i=1:lf) c(i) = f(i:i) + + end subroutine f2cs + +end function set_env + + end module fpm_environment diff --git a/src/fpm_os.c b/src/fpm_os.c index 49e1a4d5f4..ddc8f58c5f 100644 --- a/src/fpm_os.c +++ b/src/fpm_os.c @@ -14,3 +14,12 @@ char* c_realpath(char* path, char* resolved_path, int maxLength) { return _fullpath(resolved_path, path, maxLength); #endif } + +/// @brief Set environment variable using the C standard library +/// @param envname: points to a string containing the name of an environment variable to be added or altered. +/// @param envval: points to the value the environment variable is set to +/// @param overwrite: flag to determine whether an old value should be overwritten +/// @return success flag, 0 on successful execution +int c_setenv(const char *envname, const char *envval, int overwrite) { + return setenv(envname, envval, overwrite); +} From 4c42c2ab6e9871493fb653b5ba19b0d34810b906 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 11:48:09 +0200 Subject: [PATCH 09/46] test `set_env`, `delete_env` --- src/fpm_environment.f90 | 67 ++++++++++++++++++++++++++++----------- src/fpm_os.c | 9 ++++++ test/fpm_test/test_os.f90 | 50 ++++++++++++++++++++++++++++- 3 files changed, 106 insertions(+), 20 deletions(-) diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index bc0503a325..aed79d9979 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -14,6 +14,7 @@ module fpm_environment public :: os_is_unix public :: get_env public :: set_env + public :: delete_env public :: get_command_arguments_quoted public :: separator @@ -343,7 +344,6 @@ function separator() result(sep) end function separator !> Set an environment variable for the current environment using the C standard library - logical function set_env(name,value,overwrite) !> Variable name @@ -361,7 +361,8 @@ logical function set_env(name,value,overwrite) character(kind=c_char,len=1), allocatable :: c_value(:),c_name(:) interface - integer(c_int) function c_setenv(envname, envval, overwrite) bind(C,name="c_setenv") + integer(c_int) function c_setenv(envname, envval, overwrite) & + bind(C,name="c_setenv") import c_int, c_char implicit none !> Pointer to the name string @@ -370,7 +371,7 @@ integer(c_int) function c_setenv(envname, envval, overwrite) bind(C,name="c_sete character(kind=c_char,len=1), intent(in) :: envval(*) !> Overwrite option integer(c_int), intent(in), value :: overwrite - end function c_setenv + end function c_setenv end interface !> Overwrite setting @@ -387,23 +388,51 @@ end function c_setenv set_env = cerr==0_c_int - contains - - pure subroutine f2cs(f,c) - use iso_c_binding, only: c_char,c_null_char - character(*), intent(in) :: f - character(len=1,kind=c_char), allocatable, intent(out) :: c(:) - - integer :: lf,i - - lf = len(f) - allocate(c(lf+1)) - c(lf+1) = c_null_char - forall(i=1:lf) c(i) = f(i:i) - - end subroutine f2cs - end function set_env +!> Deletes an environment variable for the current environment using the C standard library +!> Returns an error if the variable did not exist in the first place +logical function delete_env(name) result(success) + + !> Variable name + character(*), intent(in) :: name + + ! Local variables + integer(c_int) :: cerr + character(kind=c_char,len=1), allocatable :: c_name(:) + + interface + integer(c_int) function c_unsetenv(envname) bind(C,name="c_unsetenv") + import c_int, c_char + implicit none + !> Pointer to the name string + character(kind=c_char,len=1), intent(in) :: envname(*) + end function c_unsetenv + end interface + + !> C strings + call f2cs(name,c_name) + + !> Call setenv + cerr = c_unsetenv(c_name) + + success = cerr==0_c_int + +end function delete_env + +!> Fortran to C allocatable string +pure subroutine f2cs(f,c) + use iso_c_binding, only: c_char,c_null_char + character(*), intent(in) :: f + character(len=1,kind=c_char), allocatable, intent(out) :: c(:) + + integer :: lf,i + + lf = len(f) + allocate(c(lf+1)) + c(lf+1) = c_null_char + forall(i=1:lf) c(i) = f(i:i) + +end subroutine f2cs end module fpm_environment diff --git a/src/fpm_os.c b/src/fpm_os.c index ddc8f58c5f..7b4ce188da 100644 --- a/src/fpm_os.c +++ b/src/fpm_os.c @@ -23,3 +23,12 @@ char* c_realpath(char* path, char* resolved_path, int maxLength) { int c_setenv(const char *envname, const char *envval, int overwrite) { return setenv(envname, envval, overwrite); } + +/// @brief Delete environment variable using the C standard library +/// @param envname: points to a string containing the name of an environment variable. +/// @return success flag, 0 on successful execution +int c_unsetenv(const char *envname) { + return unsetenv(envname); +} + + diff --git a/test/fpm_test/test_os.f90 b/test/fpm_test/test_os.f90 index 71989167f5..e3dde92433 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: join_path, mkdir, os_delete_dir, is_dir, get_local_prefix, get_home - use fpm_environment, only: os_is_unix, get_env + use fpm_environment, only: os_is_unix, get_env, set_env, delete_env use fpm_os, only: get_absolute_path, get_absolute_path_by_cd, get_current_directory implicit none @@ -21,6 +21,7 @@ subroutine collect_os(tests) tests = [ & & new_unittest('empty-path', empty_path, should_fail=.true.), & & new_unittest('only-tilde', only_tilde), & + & new_unittest('set-environment-variable', set_environment), & & new_unittest('invalid-tilde-path', invalid_tilde_path, should_fail=.true.), & & new_unittest('tilde-correct-separator', tilde_correct_separator), & & new_unittest('tilde-wrong-separator', tilde_wrong_separator, should_fail=.true.), & @@ -250,5 +251,52 @@ subroutine abs_path_cd_current(error) call test_failed(error, "Result '"//result//"' doesn't equal current directory '"//current_dir//"'"); return end if end + + !> Test creation and deletion of an environment variable + subroutine set_environment(error) + type(error_t), allocatable, intent(out) :: error + + character(*), parameter :: vname = 'fgslsdfkjei13325xssghhjewfbew' + character(*), parameter :: vvalue = '1234567890' + + character(:), allocatable :: old_value,new_value,final_value + logical :: success + + !> Ensure there's no such variable + old_value = get_env(vname,default='ERROR') + if (old_value/='ERROR') then + call test_failed(error, "There is already an env variable named "//vname) + return + end if + + !> Create variable + success = set_env(vname,value=vvalue) + if (.not.success) then + call test_failed(error, "Cannot create environment variable "//vname) + return + end if + + !> Check new value + new_value = get_env(vname,default='ERROR') + if (new_value/=vvalue) then + call test_failed(error, "Env "//vname//"="//new_value//'; expected '//vvalue) + return + end if + + !> Delete variable + success = delete_env(vname) + if (.not.success) then + call test_failed(error, "Cannot delete environment variable "//vname) + return + end if + + !> Ensure it does not exist anymore + final_value = get_env(vname,default='ERROR') + if (final_value/='ERROR') then + call test_failed(error, "Env "//vname//"="//final_value//'; it should not exist.') + return + end if + + end subroutine set_environment end module test_os From 9fdbb505157a140721b3c1fe33516baf35f06822 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 12:40:08 +0200 Subject: [PATCH 10/46] implement `hdf5` metapackage --- src/fpm_meta.f90 | 123 ++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 115 insertions(+), 8 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index c3413a368c..3404a6188c 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -27,7 +27,7 @@ module fpm_meta use fpm_manifest_dependency, only: dependency_config_t 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_environment, only: get_env,os_is_unix,set_env,delete_env 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 @@ -1932,6 +1932,78 @@ function pkgcfg_list_all(error,descriptions) result(modules) end function pkgcfg_list_all +!> +function pkgcfg_get_build_flags(name,allow_system,error) result(flags) + + !> Package name + character(*), intent(in) :: name + + !> Should pkg-config look in system paths? This is necessary for gfortran + !> that doesn't otherwise look into them + logical, intent(in) :: allow_system + + !> Error flag + type(error_t), allocatable, intent(out) :: error + + !> List of compile flags + type(string_t), allocatable :: flags(:) + + integer :: exitcode,i,nlib + logical :: old_had,success,old_allow + character(:), allocatable :: old,tokens(:) + type(string_t) :: log + + ! Check if the current environment includes system flags + old = get_env('PKG_CONFIG_ALLOW_SYSTEM_CFLAGS',default='ERROR') + old_had = old/='ERROR' + old_allow = merge(old=='1',.false.,old_had) + + ! Set system flags + success = set_env('PKG_CONFIG_ALLOW_SYSTEM_CFLAGS',value=merge('1','0',allow_system)) + if (.not.success) then + call fatal_error(error,'Cannot get pkg-config build flags: environment variable error.') + return + end if + + ! Now run wrapper + call run_wrapper(wrapper=string_t('pkg-config'), & + args=[string_t(name),string_t('--cflags')], & + exitcode=exitcode,cmd_success=success,screen_output=log) + + if (success .and. exitcode==0) then + + call remove_newline_characters(log) + + ! Split all arguments + tokens = shlex_split(log%s) + + nlib = size(tokens) + allocate(flags(nlib)) + do i=1,nlib + flags(i) = string_t(tokens(i)) + end do + + else + + allocate(flags(0)) + call fatal_error(error,'cannot get <'//name//'> build flags from pkg-config') + + end if + + ! Restore environment variable + if (old_had) then + success = set_env('PKG_CONFIG_ALLOW_SYSTEM_CFLAGS',value=old) + else + success = delete_env('PKG_CONFIG_ALLOW_SYSTEM_CFLAGS') + end if + if (.not.success) then + call fatal_error(error,'Cannot get pkg-config build flags: environment variable error.') + return + end if + + +end function pkgcfg_get_build_flags + !> Initialize HDF5 metapackage for the current system subroutine init_hdf5(this,compiler,error) class(metapackage_t), intent(inout) :: this @@ -1941,15 +2013,19 @@ subroutine init_hdf5(this,compiler,error) integer :: i logical :: s type(string_t) :: log - type(string_t), allocatable :: libs(:),modules(:) - character(len=:), allocatable :: name + type(string_t), allocatable :: libs(:),flags(:),modules(:) + character(len=:), allocatable :: name,module_flag,include_flag character(*), parameter :: candidates(5) = & [character(15) :: 'hdf5_hl_fortran','hdf5_fortran','hdf5_hl','hdf5','hdf5-serial'] + module_flag = get_module_flag(compiler,"") + include_flag = get_include_flag(compiler,"") + !> Cleanup call destroy(this) allocate(this%link_libs(0),this%incl_dirs(0),this%external_modules(0)) this%link_flags = string_t("") + this%flags = string_t("") !> Assert pkg-config is installed if (.not.assert_pkg_config()) then @@ -2004,13 +2080,44 @@ subroutine init_hdf5(this,compiler,error) end if end do - ! [TODO] manually add High-Level API libraries (HL) - - + !> Get compiler flags + flags = pkgcfg_get_build_flags(name,.false.,error) + if (allocated(error)) return + do i=1,size(flags) + + if (str_begins_with_str(flags(i)%s,include_flag)) then + this%has_include_dirs = .true. + this%incl_dirs = [this%incl_dirs, string_t(flags(i)%s(len(include_flag)+1:))] + else + this%has_build_flags = .true. + this%flags = string_t(trim(this%flags%s)//' '//flags(i)%s) + end if + + end do - call fatal_error(error,'hdf5 metapackage not finished') - + !> Add HDF5 modules as external + this%has_external_modules = .true. + this%external_modules = [string_t('h5a'), & + string_t('h5d'), & + string_t('h5es'), & + string_t('h5e'), & + string_t('h5f'), & + string_t('h5g'), & + string_t('h5i'), & + string_t('h5l'), & + string_t('h5o'), & + string_t('h5p'), & + string_t('h5r'), & + string_t('h5s'), & + string_t('h5t'), & + string_t('h5vl'), & + string_t('h5z'), & + string_t('h5lib'), & + string_t('h5global'), & + string_t('h5_gen'), & + string_t('h5fortkit'), & + string_t('hdf5')] end subroutine init_hdf5 From 8ba62ba9a9735142c34a4d796072cd3eaf4441bc Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 12:40:30 +0200 Subject: [PATCH 11/46] add hdf5 metapackage example --- example_packages/metapackage_hdf5/app/main.f90 | 15 +++++++++++++++ example_packages/metapackage_hdf5/fpm.toml | 2 ++ 2 files changed, 17 insertions(+) create mode 100644 example_packages/metapackage_hdf5/app/main.f90 create mode 100644 example_packages/metapackage_hdf5/fpm.toml diff --git a/example_packages/metapackage_hdf5/app/main.f90 b/example_packages/metapackage_hdf5/app/main.f90 new file mode 100644 index 0000000000..3735a3e525 --- /dev/null +++ b/example_packages/metapackage_hdf5/app/main.f90 @@ -0,0 +1,15 @@ +program metapackage_hdf5 + use hdf5 + implicit none + + integer :: error + + call h5open_f(error) + if (error/=0) stop -1 + + call h5close_f(error) + if (error/=0) stop -2 + + stop 0 + +end program metapackage_hdf5 diff --git a/example_packages/metapackage_hdf5/fpm.toml b/example_packages/metapackage_hdf5/fpm.toml new file mode 100644 index 0000000000..5a7d2f12b4 --- /dev/null +++ b/example_packages/metapackage_hdf5/fpm.toml @@ -0,0 +1,2 @@ +name = "metapackage_hdf5" +dependencies.hdf5="*" From 8b2d48ff199254a5ae4c8a6a7fda4a4b8d674190 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 12:45:44 +0200 Subject: [PATCH 12/46] add hdf5 workflow --- .github/workflows/meta.yml | 10 ++++++++-- ci/meta_tests.sh | 5 +++++ 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 773978caea..96c3b5c191 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -67,6 +67,7 @@ jobs: wget unzip curl + hdf5 - name: (Windows) Setup VS Build environment if: contains(matrix.os,'windows') && contains(matrix.mpi,'intel') @@ -93,12 +94,12 @@ jobs: - name: (Ubuntu) Install OpenMPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'openmpi') run: | - sudo apt install -y -q openmpi-bin libopenmpi-dev + sudo apt install -y -q openmpi-bin libopenmpi-dev libhdf5-openmpi-dev - name: (Ubuntu) Install MPICH if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'mpich') run: | - sudo apt install -y -q mpich + sudo apt install -y -q mpich libhdf5-mpich-dev - name: (Ubuntu) Retrieve Intel toolchain if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') @@ -197,6 +198,11 @@ jobs: run: | brew install openmpi #--cc=gcc-${{ env.GCC_V }} openmpi + - name: (macOS) Install homebrew HDF5 + if: contains(matrix.os,'macos') + run: | + brew install homebrew/science/hdf5 --with-fortran --with-mpi --with-fortran2003 + # Phase 1: Bootstrap fpm with existing version - name: Install fpm uses: fortran-lang/setup-fpm@v5 diff --git a/ci/meta_tests.sh b/ci/meta_tests.sh index c2911d2737..d9749bb511 100755 --- a/ci/meta_tests.sh +++ b/ci/meta_tests.sh @@ -42,5 +42,10 @@ pushd metapackage_mpi_c "$fpm" run --verbose popd +pushd metapackage_hdf5 +"$fpm" build --verbose +"$fpm" run --verbose +popd + # Cleanup rm -rf ./*/build From a65d1a45b19e20befe65916dacb105331141fe0a Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 12:48:36 +0200 Subject: [PATCH 13/46] `setenv` for Windows --- src/fpm_os.c | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/fpm_os.c b/src/fpm_os.c index 7b4ce188da..b3a7570dbd 100644 --- a/src/fpm_os.c +++ b/src/fpm_os.c @@ -21,7 +21,17 @@ char* c_realpath(char* path, char* resolved_path, int maxLength) { /// @param overwrite: flag to determine whether an old value should be overwritten /// @return success flag, 0 on successful execution int c_setenv(const char *envname, const char *envval, int overwrite) { +#ifndef _WIN32 return setenv(envname, envval, overwrite); +#else + int errcode = 0; + if(!overwrite) { + size_t envsize = 0; + errcode = getenv_s(&envsize, NULL, 0, envname); + if(errcode || envsize) return errcode; + } + return _putenv_s(envname, envval); +#endif } /// @brief Delete environment variable using the C standard library From 4843a06578a603335f38ee43f58b872ebfcde9f2 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 12:50:29 +0200 Subject: [PATCH 14/46] `unsetenv` for Windows --- src/fpm_os.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/fpm_os.c b/src/fpm_os.c index b3a7570dbd..c227f1ac50 100644 --- a/src/fpm_os.c +++ b/src/fpm_os.c @@ -28,7 +28,7 @@ int c_setenv(const char *envname, const char *envval, int overwrite) { if(!overwrite) { size_t envsize = 0; errcode = getenv_s(&envsize, NULL, 0, envname); - if(errcode || envsize) return errcode; + if (errcode || envsize) return errcode; } return _putenv_s(envname, envval); #endif @@ -38,7 +38,11 @@ int c_setenv(const char *envname, const char *envval, int overwrite) { /// @param envname: points to a string containing the name of an environment variable. /// @return success flag, 0 on successful execution int c_unsetenv(const char *envname) { +#ifndef _WIN32 return unsetenv(envname); +#else + return _putenv_s(envname,NULL); +#endif } From 77f86fb7a6bf54d71e5373a019a83ff76d08de44 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 13:00:08 +0200 Subject: [PATCH 15/46] create `pkg_config` module --- src/fpm_meta.f90 | 322 +------------------------------------- src/fpm_pkg_config.f90 | 348 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 349 insertions(+), 321 deletions(-) create mode 100644 src/fpm_pkg_config.f90 diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 3404a6188c..1d02194d4f 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -31,6 +31,7 @@ module fpm_meta 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 fpm_pkg_config use shlex_module, only: shlex_split => split use regex_module, only: regex use iso_fortran_env, only: stdout => output_unit @@ -1274,109 +1275,6 @@ subroutine assert_mpi_wrappers(wrappers,compiler,verbose) end subroutine assert_mpi_wrappers -!> Check whether pkg-config is available on the local system -logical function assert_pkg_config() - - integer :: exitcode - logical :: success - type(string_t) :: log - - call run_wrapper(wrapper=string_t('pkg-config'),args=[string_t('-h')], & - exitcode=exitcode,cmd_success=success,screen_output=log) - - assert_pkg_config = exitcode==0 .and. success - -end function assert_pkg_config - -!> Simple call to execute_command_line involving one mpi* wrapper -subroutine run_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=.false. - 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 - - ! Empty command - if (len_trim(wrapper)<=0) then - if (echo_local) 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) - - 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 - - if (echo_local) 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_wrapper - !> Get MPI library type from the wrapper command. Currently, only OpenMPI is supported integer function which_mpi_library(wrapper,compiler,verbose) type(string_t), intent(in) :: wrapper @@ -1786,224 +1684,6 @@ subroutine filter_link_arguments(compiler,command) end subroutine filter_link_arguments -!> Get package version from pkg-config -type(string_t) function pkgcfg_get_version(package,error) result(screen) - - !> Package name - character(*), intent(in) :: package - - !> Error handler - type(error_t), allocatable, intent(out) :: error - - integer :: exitcode - logical :: success - type(string_t) :: log - - call run_wrapper(wrapper=string_t('pkg-config'), & - args=[string_t(package),string_t('--modversion')], & - exitcode=exitcode,cmd_success=success,screen_output=log) - - if (success .and. exitcode==0) then - call remove_newline_characters(log) - screen = log - else - screen = string_t("") - end if - -end function pkgcfg_get_version - -!> Check if pkgcfg has package -logical function pkgcfg_has_package(name) result(success) - - !> Package name - character(*), intent(in) :: name - - integer :: exitcode - logical :: cmdok - type(string_t) :: log - - call run_wrapper(wrapper=string_t('pkg-config'), & - args=[string_t(name),string_t('--exists')], & - exitcode=exitcode,cmd_success=cmdok,screen_output=log) - - !> pkg-config --exists returns 0 only if the package exists - success = cmdok .and. exitcode==0 - -end function pkgcfg_has_package - - -!> Get package libraries from pkg-config -function pkgcfg_get_libs(package,error) result(libraries) - - !> Package name - character(*), intent(in) :: package - - !> Error handler - type(error_t), allocatable, intent(out) :: error - - !> A list of libraries - type(string_t), allocatable :: libraries(:) - - integer :: exitcode,nlib,i - logical :: success - character(len=:), allocatable :: tokens(:) - type(string_t) :: log - - call run_wrapper(wrapper=string_t('pkg-config'), & - args=[string_t(package),string_t('--libs')], & - exitcode=exitcode,cmd_success=success,screen_output=log) - - if (success .and. exitcode==0) then - - call remove_newline_characters(log) - - ! Split all arguments - tokens = shlex_split(log%s) - - nlib = size(tokens) - allocate(libraries(nlib)) - do i=1,nlib - libraries(i) = string_t(tokens(i)) - end do - - else - - allocate(libraries(0)) - call fatal_error(error,'cannot get <'//package//'> libraries from pkg-config') - - end if - -end function pkgcfg_get_libs - -!> Return whole list of available pkg-cfg packages -function pkgcfg_list_all(error,descriptions) result(modules) - - !> Error handler - type(error_t), allocatable, intent(out) :: error - - !> A list of all available packages - type(string_t), allocatable :: modules(:) - - !> An optional list of package descriptions - type(string_t), optional, allocatable, intent(out) :: descriptions(:) - - integer :: exitcode,i,spc - logical :: success - character(len=:), allocatable :: lines(:) - type(string_t) :: log - type(string_t), allocatable :: mods(:),descr(:) - character(*), parameter :: CRLF = achar(13)//new_line('a') - - call run_wrapper(wrapper=string_t('pkg-config'), & - args=[string_t('--list-all')], & - exitcode=exitcode,cmd_success=success,screen_output=log) - - if (.not.(success .and. exitcode==0)) then - call fatal_error(error,'cannot get pkg-config modules') - allocate(modules(0)) - return - end if - - !> Extract list - call split(log%s,lines,CRLF) - allocate(mods(size(lines)),descr(size(lines))) - - do i=1,size(lines) - - ! Module names have no spaces - spc = index(lines(i),' ') - - if (spc>0) then - - mods(i) = string_t(trim(adjustl(lines(i)(1:spc)))) - descr(i) = string_t(trim(adjustl(lines(i)(spc+1:)))) - - else - - mods(i) = string_t(trim(adjustl(lines(i)))) - descr(i) = string_t("") - - end if - - end do - - call move_alloc(from=mods,to=modules) - if (present(descriptions)) call move_alloc(from=descr,to=descriptions) - -end function pkgcfg_list_all - -!> -function pkgcfg_get_build_flags(name,allow_system,error) result(flags) - - !> Package name - character(*), intent(in) :: name - - !> Should pkg-config look in system paths? This is necessary for gfortran - !> that doesn't otherwise look into them - logical, intent(in) :: allow_system - - !> Error flag - type(error_t), allocatable, intent(out) :: error - - !> List of compile flags - type(string_t), allocatable :: flags(:) - - integer :: exitcode,i,nlib - logical :: old_had,success,old_allow - character(:), allocatable :: old,tokens(:) - type(string_t) :: log - - ! Check if the current environment includes system flags - old = get_env('PKG_CONFIG_ALLOW_SYSTEM_CFLAGS',default='ERROR') - old_had = old/='ERROR' - old_allow = merge(old=='1',.false.,old_had) - - ! Set system flags - success = set_env('PKG_CONFIG_ALLOW_SYSTEM_CFLAGS',value=merge('1','0',allow_system)) - if (.not.success) then - call fatal_error(error,'Cannot get pkg-config build flags: environment variable error.') - return - end if - - ! Now run wrapper - call run_wrapper(wrapper=string_t('pkg-config'), & - args=[string_t(name),string_t('--cflags')], & - exitcode=exitcode,cmd_success=success,screen_output=log) - - if (success .and. exitcode==0) then - - call remove_newline_characters(log) - - ! Split all arguments - tokens = shlex_split(log%s) - - nlib = size(tokens) - allocate(flags(nlib)) - do i=1,nlib - flags(i) = string_t(tokens(i)) - end do - - else - - allocate(flags(0)) - call fatal_error(error,'cannot get <'//name//'> build flags from pkg-config') - - end if - - ! Restore environment variable - if (old_had) then - success = set_env('PKG_CONFIG_ALLOW_SYSTEM_CFLAGS',value=old) - else - success = delete_env('PKG_CONFIG_ALLOW_SYSTEM_CFLAGS') - end if - if (.not.success) then - call fatal_error(error,'Cannot get pkg-config build flags: environment variable error.') - return - end if - - -end function pkgcfg_get_build_flags - !> Initialize HDF5 metapackage for the current system subroutine init_hdf5(this,compiler,error) class(metapackage_t), intent(inout) :: this diff --git a/src/fpm_pkg_config.f90 b/src/fpm_pkg_config.f90 new file mode 100644 index 0000000000..3b12e65337 --- /dev/null +++ b/src/fpm_pkg_config.f90 @@ -0,0 +1,348 @@ +!># The fpm interface to pkg-config +!> +!> This module contains wrapper functions to interface with a pkg-config installation. +!> +module fpm_pkg_config + +use fpm_strings, only: string_t,str_begins_with_str,len_trim,remove_newline_characters, & + split +use fpm_error, only: error_t, fatal_error, fpm_stop +use fpm_filesystem, only: get_temp_filename,getline +use fpm_environment, only: get_env,os_is_unix,set_env,delete_env +use shlex_module, only: shlex_split => split +implicit none +private + +public :: assert_pkg_config +public :: pkgcfg_get_version +public :: pkgcfg_get_libs +public :: pkgcfg_get_build_flags +public :: pkgcfg_has_package +public :: pkgcfg_list_all +public :: run_wrapper + +contains + +!> Check whether pkg-config is available on the local system +logical function assert_pkg_config() + + integer :: exitcode + logical :: success + type(string_t) :: log + + call run_wrapper(wrapper=string_t('pkg-config'),args=[string_t('-h')], & + exitcode=exitcode,cmd_success=success,screen_output=log) + + assert_pkg_config = exitcode==0 .and. success + +end function assert_pkg_config + +!> Get package version from pkg-config +type(string_t) function pkgcfg_get_version(package,error) result(screen) + + !> Package name + character(*), intent(in) :: package + + !> Error handler + type(error_t), allocatable, intent(out) :: error + + integer :: exitcode + logical :: success + type(string_t) :: log + + call run_wrapper(wrapper=string_t('pkg-config'), & + args=[string_t(package),string_t('--modversion')], & + exitcode=exitcode,cmd_success=success,screen_output=log) + + if (success .and. exitcode==0) then + call remove_newline_characters(log) + screen = log + else + screen = string_t("") + end if + +end function pkgcfg_get_version + +!> Check if pkgcfg has package +logical function pkgcfg_has_package(name) result(success) + + !> Package name + character(*), intent(in) :: name + + integer :: exitcode + logical :: cmdok + type(string_t) :: log + + call run_wrapper(wrapper=string_t('pkg-config'), & + args=[string_t(name),string_t('--exists')], & + exitcode=exitcode,cmd_success=cmdok,screen_output=log) + + !> pkg-config --exists returns 0 only if the package exists + success = cmdok .and. exitcode==0 + +end function pkgcfg_has_package + + +!> Get package libraries from pkg-config +function pkgcfg_get_libs(package,error) result(libraries) + + !> Package name + character(*), intent(in) :: package + + !> Error handler + type(error_t), allocatable, intent(out) :: error + + !> A list of libraries + type(string_t), allocatable :: libraries(:) + + integer :: exitcode,nlib,i + logical :: success + character(len=:), allocatable :: tokens(:) + type(string_t) :: log + + call run_wrapper(wrapper=string_t('pkg-config'), & + args=[string_t(package),string_t('--libs')], & + exitcode=exitcode,cmd_success=success,screen_output=log) + + if (success .and. exitcode==0) then + + call remove_newline_characters(log) + + ! Split all arguments + tokens = shlex_split(log%s) + + nlib = size(tokens) + allocate(libraries(nlib)) + do i=1,nlib + libraries(i) = string_t(tokens(i)) + end do + + else + + allocate(libraries(0)) + call fatal_error(error,'cannot get <'//package//'> libraries from pkg-config') + + end if + +end function pkgcfg_get_libs + +!> Return whole list of available pkg-cfg packages +function pkgcfg_list_all(error,descriptions) result(modules) + + !> Error handler + type(error_t), allocatable, intent(out) :: error + + !> A list of all available packages + type(string_t), allocatable :: modules(:) + + !> An optional list of package descriptions + type(string_t), optional, allocatable, intent(out) :: descriptions(:) + + integer :: exitcode,i,spc + logical :: success + character(len=:), allocatable :: lines(:) + type(string_t) :: log + type(string_t), allocatable :: mods(:),descr(:) + character(*), parameter :: CRLF = achar(13)//new_line('a') + + call run_wrapper(wrapper=string_t('pkg-config'), & + args=[string_t('--list-all')], & + exitcode=exitcode,cmd_success=success,screen_output=log) + + if (.not.(success .and. exitcode==0)) then + call fatal_error(error,'cannot get pkg-config modules') + allocate(modules(0)) + return + end if + + !> Extract list + call split(log%s,lines,CRLF) + allocate(mods(size(lines)),descr(size(lines))) + + do i=1,size(lines) + + ! Module names have no spaces + spc = index(lines(i),' ') + + if (spc>0) then + + mods(i) = string_t(trim(adjustl(lines(i)(1:spc)))) + descr(i) = string_t(trim(adjustl(lines(i)(spc+1:)))) + + else + + mods(i) = string_t(trim(adjustl(lines(i)))) + descr(i) = string_t("") + + end if + + end do + + call move_alloc(from=mods,to=modules) + if (present(descriptions)) call move_alloc(from=descr,to=descriptions) + +end function pkgcfg_list_all + +!> Get build flags (option to include flags from system directories, that +!> gfortran does not look into by default) +function pkgcfg_get_build_flags(name,allow_system,error) result(flags) + + !> Package name + character(*), intent(in) :: name + + !> Should pkg-config look in system paths? This is necessary for gfortran + !> that doesn't otherwise look into them + logical, intent(in) :: allow_system + + !> Error flag + type(error_t), allocatable, intent(out) :: error + + !> List of compile flags + type(string_t), allocatable :: flags(:) + + integer :: exitcode,i,nlib + logical :: old_had,success,old_allow + character(:), allocatable :: old,tokens(:) + type(string_t) :: log + + ! Check if the current environment includes system flags + old = get_env('PKG_CONFIG_ALLOW_SYSTEM_CFLAGS',default='ERROR') + old_had = old/='ERROR' + old_allow = merge(old=='1',.false.,old_had) + + ! Set system flags + success = set_env('PKG_CONFIG_ALLOW_SYSTEM_CFLAGS',value=merge('1','0',allow_system)) + if (.not.success) then + call fatal_error(error,'Cannot get pkg-config build flags: environment variable error.') + return + end if + + ! Now run wrapper + call run_wrapper(wrapper=string_t('pkg-config'), & + args=[string_t(name),string_t('--cflags')], & + exitcode=exitcode,cmd_success=success,screen_output=log) + + if (success .and. exitcode==0) then + + call remove_newline_characters(log) + + ! Split all arguments + tokens = shlex_split(log%s) + + nlib = size(tokens) + allocate(flags(nlib)) + do i=1,nlib + flags(i) = string_t(tokens(i)) + end do + + else + + allocate(flags(0)) + call fatal_error(error,'cannot get <'//name//'> build flags from pkg-config') + + end if + + ! Restore environment variable + if (old_had) then + success = set_env('PKG_CONFIG_ALLOW_SYSTEM_CFLAGS',value=old) + else + success = delete_env('PKG_CONFIG_ALLOW_SYSTEM_CFLAGS') + end if + if (.not.success) then + call fatal_error(error,'Cannot get pkg-config build flags: environment variable error.') + return + end if + + +end function pkgcfg_get_build_flags + +!> Simple call to execute_command_line involving one mpi* wrapper +subroutine run_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=.false. + 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 + + ! Empty command + if (len_trim(wrapper)<=0) then + if (echo_local) 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) + + 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 + + if (echo_local) 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_wrapper + +end module fpm_pkg_config From 8349d7363a891ce0aeeb1d296c4e6d2303ff2090 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 13:05:52 +0200 Subject: [PATCH 16/46] putenv: fix --- src/fpm_os.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/fpm_os.c b/src/fpm_os.c index c227f1ac50..079c37f845 100644 --- a/src/fpm_os.c +++ b/src/fpm_os.c @@ -41,7 +41,9 @@ int c_unsetenv(const char *envname) { #ifndef _WIN32 return unsetenv(envname); #else - return _putenv_s(envname,NULL); + // _putenv_s returns a non-zero code when deleting a variable + int errcode = _putenv_s(envname,NULL); + return 0; #endif } From d1cc71347c8bd89ea9587d4e2ade559ad90e7cfc Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 13:20:19 +0200 Subject: [PATCH 17/46] Update fpm_os.c --- 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 079c37f845..bc01603a4e 100644 --- a/src/fpm_os.c +++ b/src/fpm_os.c @@ -42,7 +42,7 @@ int c_unsetenv(const char *envname) { return unsetenv(envname); #else // _putenv_s returns a non-zero code when deleting a variable - int errcode = _putenv_s(envname,NULL); + int errcode = _putenv_s(envname,'\0'); return 0; #endif } From f3fca0859bf112472c449a602394f9780e989904 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 07:12:45 -0500 Subject: [PATCH 18/46] Update fpm_os.c --- src/fpm_os.c | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/fpm_os.c b/src/fpm_os.c index 079c37f845..fe7050186a 100644 --- a/src/fpm_os.c +++ b/src/fpm_os.c @@ -21,7 +21,7 @@ char* c_realpath(char* path, char* resolved_path, int maxLength) { /// @param overwrite: flag to determine whether an old value should be overwritten /// @return success flag, 0 on successful execution int c_setenv(const char *envname, const char *envval, int overwrite) { -#ifndef _WIN32 +#ifndef _WIN32 return setenv(envname, envval, overwrite); #else int errcode = 0; @@ -30,21 +30,24 @@ int c_setenv(const char *envname, const char *envval, int overwrite) { errcode = getenv_s(&envsize, NULL, 0, envname); if (errcode || envsize) return errcode; } - return _putenv_s(envname, envval); + return _putenv_s(envname, envval); #endif -} +} /// @brief Delete environment variable using the C standard library /// @param envname: points to a string containing the name of an environment variable. /// @return success flag, 0 on successful execution int c_unsetenv(const char *envname) { -#ifndef _WIN32 +#ifndef _WIN32 return unsetenv(envname); #else + char* str = malloc(10*sizeof(char)); + str = '\0'; // _putenv_s returns a non-zero code when deleting a variable - int errcode = _putenv_s(envname,NULL); - return 0; -#endif -} + int errcode = _putenv_s(envname,str); + free(str); + return 0; +#endif +} From 8d73c855a434959c40afd68d296a66763a9efa7c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 07:43:14 -0500 Subject: [PATCH 19/46] fix windows delete_env --- src/fpm_os.c | 10 ++++---- test/fpm_test/test_os.f90 | 48 +++++++++++++++++++++------------------ 2 files changed, 32 insertions(+), 26 deletions(-) diff --git a/src/fpm_os.c b/src/fpm_os.c index fe7050186a..54e498715b 100644 --- a/src/fpm_os.c +++ b/src/fpm_os.c @@ -1,4 +1,5 @@ #include +#include /// @brief Determine the absolute, canonicalized path for a given path. /// @param path @@ -41,12 +42,13 @@ int c_unsetenv(const char *envname) { #ifndef _WIN32 return unsetenv(envname); #else - char* str = malloc(10*sizeof(char)); - str = '\0'; - // _putenv_s returns a non-zero code when deleting a variable + char* str = malloc(64*sizeof(char)); + *str = '\0'; int errcode = _putenv_s(envname,str); + // Windows returns a non-0 code when setting empty variable + if (errcode==-1) errcode=0; free(str); - return 0; + return errcode; #endif } diff --git a/test/fpm_test/test_os.f90 b/test/fpm_test/test_os.f90 index e3dde92433..a0b5c11a79 100644 --- a/test/fpm_test/test_os.f90 +++ b/test/fpm_test/test_os.f90 @@ -251,52 +251,56 @@ subroutine abs_path_cd_current(error) call test_failed(error, "Result '"//result//"' doesn't equal current directory '"//current_dir//"'"); return end if end - + !> Test creation and deletion of an environment variable subroutine set_environment(error) type(error_t), allocatable, intent(out) :: error - - character(*), parameter :: vname = 'fgslsdfkjei13325xssghhjewfbew' + + character(*), parameter :: vname = 'hiufewhiugw' character(*), parameter :: vvalue = '1234567890' - + character(:), allocatable :: old_value,new_value,final_value logical :: success - + !> Ensure there's no such variable old_value = get_env(vname,default='ERROR') - if (old_value/='ERROR') then + if (old_value/='ERROR') then call test_failed(error, "There is already an env variable named "//vname) return end if - + !> Create variable success = set_env(vname,value=vvalue) - if (.not.success) then + if (.not.success) then call test_failed(error, "Cannot create environment variable "//vname) return end if - + !> Check new value new_value = get_env(vname,default='ERROR') - if (new_value/=vvalue) then + if (new_value/=vvalue) then call test_failed(error, "Env "//vname//"="//new_value//'; expected '//vvalue) return - end if - + end if + !> Delete variable success = delete_env(vname) - if (.not.success) then + if (.not.success) then call test_failed(error, "Cannot delete environment variable "//vname) return - end if - - !> Ensure it does not exist anymore - final_value = get_env(vname,default='ERROR') - if (final_value/='ERROR') then - call test_failed(error, "Env "//vname//"="//final_value//'; it should not exist.') - return - end if - + end if + + !> Ensure it does not exist anymore + !> Do not test this on Windows: due to a Windows bug, environment variables do not get deleted + !> https://developercommunity.visualstudio.com/t/-putenv-sname-doesnt-always-delete-windows-copy-of/1587426 + if (os_is_unix()) then + final_value = get_env(vname,default='ERROR') + if (final_value/='ERROR') then + call test_failed(error, "Env "//vname//"="//final_value//'; it should not exist.') + return + end if + endif + end subroutine set_environment end module test_os From 2cf0a9bfe23e5e709c6635c5f7595b4a308be21d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 14:59:16 +0200 Subject: [PATCH 20/46] simpler brew install --- .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 96c3b5c191..57f066bf00 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -201,7 +201,7 @@ jobs: - name: (macOS) Install homebrew HDF5 if: contains(matrix.os,'macos') run: | - brew install homebrew/science/hdf5 --with-fortran --with-mpi --with-fortran2003 + brew install homebrew/science/hdf5 # Phase 1: Bootstrap fpm with existing version - name: Install fpm From db8009ad435ad60a881ebddb0b2df0b71ad3c165 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:00:26 +0200 Subject: [PATCH 21/46] trim strings --- src/fpm_pkg_config.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fpm_pkg_config.f90 b/src/fpm_pkg_config.f90 index 3b12e65337..88978cc31b 100644 --- a/src/fpm_pkg_config.f90 +++ b/src/fpm_pkg_config.f90 @@ -114,7 +114,7 @@ function pkgcfg_get_libs(package,error) result(libraries) nlib = size(tokens) allocate(libraries(nlib)) do i=1,nlib - libraries(i) = string_t(tokens(i)) + libraries(i) = string_t(trim(tokens(i))) end do else @@ -232,7 +232,7 @@ function pkgcfg_get_build_flags(name,allow_system,error) result(flags) nlib = size(tokens) allocate(flags(nlib)) do i=1,nlib - flags(i) = string_t(tokens(i)) + flags(i) = string_t(trim(tokens(i))) end do else From 9e2dcc1aeddd3b40cdebabc0ea2477c0cef44954 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:02:05 +0200 Subject: [PATCH 22/46] 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 57f066bf00..574197a686 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -201,7 +201,7 @@ jobs: - name: (macOS) Install homebrew HDF5 if: contains(matrix.os,'macos') run: | - brew install homebrew/science/hdf5 + brew install hdf5 # Phase 1: Bootstrap fpm with existing version - name: Install fpm From ac15668596686a4e57b47bdd7409482e3ead80af Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:06:30 +0200 Subject: [PATCH 23/46] fpm_os -> fpm_environment to enable single-file build --- src/fpm_environment.c | 38 ++++++++++++++++++++++++++++++++++++++ src/fpm_os.c | 35 ----------------------------------- 2 files changed, 38 insertions(+), 35 deletions(-) create mode 100644 src/fpm_environment.c diff --git a/src/fpm_environment.c b/src/fpm_environment.c new file mode 100644 index 0000000000..34a3140840 --- /dev/null +++ b/src/fpm_environment.c @@ -0,0 +1,38 @@ +#include +#include + +/// @brief Set environment variable using the C standard library +/// @param envname: points to a string containing the name of an environment variable to be added or altered. +/// @param envval: points to the value the environment variable is set to +/// @param overwrite: flag to determine whether an old value should be overwritten +/// @return success flag, 0 on successful execution +int c_setenv(const char *envname, const char *envval, int overwrite) { +#ifndef _WIN32 + return setenv(envname, envval, overwrite); +#else + int errcode = 0; + if(!overwrite) { + size_t envsize = 0; + errcode = getenv_s(&envsize, NULL, 0, envname); + if (errcode || envsize) return errcode; + } + return _putenv_s(envname, envval); +#endif +} + +/// @brief Delete environment variable using the C standard library +/// @param envname: points to a string containing the name of an environment variable. +/// @return success flag, 0 on successful execution +int c_unsetenv(const char *envname) { +#ifndef _WIN32 + return unsetenv(envname); +#else + char* str = malloc(64*sizeof(char)); + *str = '\0'; + int errcode = _putenv_s(envname,str); + // Windows returns a non-0 code when setting empty variable + if (errcode==-1) errcode=0; + free(str); + return errcode; +#endif +} diff --git a/src/fpm_os.c b/src/fpm_os.c index 54e498715b..c423c3a28b 100644 --- a/src/fpm_os.c +++ b/src/fpm_os.c @@ -16,40 +16,5 @@ char* c_realpath(char* path, char* resolved_path, int maxLength) { #endif } -/// @brief Set environment variable using the C standard library -/// @param envname: points to a string containing the name of an environment variable to be added or altered. -/// @param envval: points to the value the environment variable is set to -/// @param overwrite: flag to determine whether an old value should be overwritten -/// @return success flag, 0 on successful execution -int c_setenv(const char *envname, const char *envval, int overwrite) { -#ifndef _WIN32 - return setenv(envname, envval, overwrite); -#else - int errcode = 0; - if(!overwrite) { - size_t envsize = 0; - errcode = getenv_s(&envsize, NULL, 0, envname); - if (errcode || envsize) return errcode; - } - return _putenv_s(envname, envval); -#endif -} - -/// @brief Delete environment variable using the C standard library -/// @param envname: points to a string containing the name of an environment variable. -/// @return success flag, 0 on successful execution -int c_unsetenv(const char *envname) { -#ifndef _WIN32 - return unsetenv(envname); -#else - char* str = malloc(64*sizeof(char)); - *str = '\0'; - int errcode = _putenv_s(envname,str); - // Windows returns a non-0 code when setting empty variable - if (errcode==-1) errcode=0; - free(str); - return errcode; -#endif -} From 39779a48aece694e18f124c1eff0b8b53b064fc9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:09:58 +0200 Subject: [PATCH 24/46] ubuntu: fix hdf apt install --- .github/workflows/meta.yml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 574197a686..869689d189 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -94,12 +94,12 @@ jobs: - name: (Ubuntu) Install OpenMPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'openmpi') run: | - sudo apt install -y -q openmpi-bin libopenmpi-dev libhdf5-openmpi-dev + sudo apt install -y -q openmpi-bin libopenmpi-dev libhdf5-dev libhdf5-openmpi-dev - name: (Ubuntu) Install MPICH if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'mpich') run: | - sudo apt install -y -q mpich libhdf5-mpich-dev + sudo apt install -y -q mpich libhdf5-dev libhdf5-mpich-dev - name: (Ubuntu) Retrieve Intel toolchain if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') @@ -108,6 +108,7 @@ jobs: wget -O- https://apt.repos.intel.com/intel-gpg-keys/GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB | gpg --dearmor | sudo tee /usr/share/keyrings/oneapi-archive-keyring.gpg > /dev/null echo "deb [signed-by=/usr/share/keyrings/oneapi-archive-keyring.gpg] https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list sudo apt-get update + sudo apt install -y -q libhdf5-dev - name: (Ubuntu) Install Intel oneAPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') From 427c73062bada24d2dc7b42c611491daf620a3c8 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:15:30 +0200 Subject: [PATCH 25/46] c functions: not in single-file source --- src/fpm_environment.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index aed79d9979..cea8a633e5 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -384,8 +384,9 @@ end function c_setenv call f2cs(value,c_value) !> Call setenv +#ifndef FPM_BOOTSTRAP cerr = c_setenv(c_name,c_value,cover) - +#endif set_env = cerr==0_c_int end function set_env @@ -414,8 +415,9 @@ end function c_unsetenv call f2cs(name,c_name) !> Call setenv +#ifndef FPM_BOOTSTRAP cerr = c_unsetenv(c_name) - +#endif success = cerr==0_c_int end function delete_env From 5bc7962e4c7b682144bece635695f4db98d81266 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:22:30 +0200 Subject: [PATCH 26/46] tmp: verbose --- src/fpm_meta.f90 | 7 ++++++- src/fpm_pkg_config.f90 | 4 ++-- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 1d02194d4f..f8af06bc06 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -329,7 +329,7 @@ subroutine resolve_model(self,model,error) 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 + model%link_flags = model%link_flags//' '//self%link_flags%s end if if (self%has_link_libraries) then @@ -1754,9 +1754,14 @@ subroutine init_hdf5(this,compiler,error) this%has_link_libraries = .true. this%link_libs = [this%link_libs, string_t(libs(i)%s(3:))] + print *, 'HDF5: add link library '//libs(i)%s(3:) + else ! -L and other: concatenate this%has_link_flags = .true. this%link_flags = string_t(trim(this%link_flags%s)//' '//libs(i)%s) + + print *, 'HDF5: add link flag '//libs(i)%s + end if end do diff --git a/src/fpm_pkg_config.f90 b/src/fpm_pkg_config.f90 index 88978cc31b..d2e01e066f 100644 --- a/src/fpm_pkg_config.f90 +++ b/src/fpm_pkg_config.f90 @@ -114,7 +114,7 @@ function pkgcfg_get_libs(package,error) result(libraries) nlib = size(tokens) allocate(libraries(nlib)) do i=1,nlib - libraries(i) = string_t(trim(tokens(i))) + libraries(i) = string_t(string_t(trim(adjustl(tokens(i)))) end do else @@ -232,7 +232,7 @@ function pkgcfg_get_build_flags(name,allow_system,error) result(flags) nlib = size(tokens) allocate(flags(nlib)) do i=1,nlib - flags(i) = string_t(trim(tokens(i))) + flags(i) = string_t(trim(adjustl(tokens(i)))) end do else From c369e7aeaa99695a57b50dfff54a5678ca057f5b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:24:08 +0200 Subject: [PATCH 27/46] Update fpm_pkg_config.f90 --- src/fpm_pkg_config.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_pkg_config.f90 b/src/fpm_pkg_config.f90 index d2e01e066f..168cc064b6 100644 --- a/src/fpm_pkg_config.f90 +++ b/src/fpm_pkg_config.f90 @@ -114,7 +114,7 @@ function pkgcfg_get_libs(package,error) result(libraries) nlib = size(tokens) allocate(libraries(nlib)) do i=1,nlib - libraries(i) = string_t(string_t(trim(adjustl(tokens(i)))) + libraries(i) = string_t(string_t(trim(adjustl(tokens(i))))) end do else From 83c287d0d982af46a674c01e961784db6cce1c03 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:26:39 +0200 Subject: [PATCH 28/46] Update fpm_pkg_config.f90 --- src/fpm_pkg_config.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_pkg_config.f90 b/src/fpm_pkg_config.f90 index 168cc064b6..eb4bc5f822 100644 --- a/src/fpm_pkg_config.f90 +++ b/src/fpm_pkg_config.f90 @@ -114,7 +114,7 @@ function pkgcfg_get_libs(package,error) result(libraries) nlib = size(tokens) allocate(libraries(nlib)) do i=1,nlib - libraries(i) = string_t(string_t(trim(adjustl(tokens(i))))) + libraries(i) = string_t(trim(adjustl(tokens(i)))) end do else From f9e812fe9f91e80a770036f090cac5a7a2f2e3ad Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:33:21 +0200 Subject: [PATCH 29/46] install hwloc, fabric --- .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 869689d189..b6679aba81 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -94,12 +94,12 @@ jobs: - name: (Ubuntu) Install OpenMPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'openmpi') run: | - sudo apt install -y -q openmpi-bin libopenmpi-dev libhdf5-dev libhdf5-openmpi-dev + sudo apt install -y -q openmpi-bin libopenmpi-dev hwloc fabric libhdf5-dev libhdf5-openmpi-dev - name: (Ubuntu) Install MPICH if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'mpich') run: | - sudo apt install -y -q mpich libhdf5-dev libhdf5-mpich-dev + sudo apt install -y -q mpich hwloc fabric libhdf5-dev libhdf5-mpich-dev - name: (Ubuntu) Retrieve Intel toolchain if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') From fac90887019a1303da97d9088a6ca99dc488e363 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:40:14 +0200 Subject: [PATCH 30/46] hdf5-fortran --- .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 b6679aba81..4667e07ab4 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -94,12 +94,12 @@ jobs: - name: (Ubuntu) Install OpenMPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'openmpi') run: | - sudo apt install -y -q openmpi-bin libopenmpi-dev hwloc fabric libhdf5-dev libhdf5-openmpi-dev + sudo apt install -y -q openmpi-bin libopenmpi-dev hwloc fabric libhdf5-dev libhdf5-openmpi-dev hdf5-fortran - name: (Ubuntu) Install MPICH if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'mpich') run: | - sudo apt install -y -q mpich hwloc fabric libhdf5-dev libhdf5-mpich-dev + sudo apt install -y -q mpich hwloc fabric libhdf5-dev libhdf5-mpich-dev hdf5-fortran - name: (Ubuntu) Retrieve Intel toolchain if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') @@ -108,7 +108,7 @@ jobs: wget -O- https://apt.repos.intel.com/intel-gpg-keys/GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB | gpg --dearmor | sudo tee /usr/share/keyrings/oneapi-archive-keyring.gpg > /dev/null echo "deb [signed-by=/usr/share/keyrings/oneapi-archive-keyring.gpg] https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list sudo apt-get update - sudo apt install -y -q libhdf5-dev + sudo apt install -y -q hdf5-fortran libhdf5-dev - name: (Ubuntu) Install Intel oneAPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') From 13870534a7501f542b8ea90b4c4910e07ba5f744 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:43:01 +0200 Subject: [PATCH 31/46] 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 4667e07ab4..8f1a950a7b 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -94,12 +94,12 @@ jobs: - name: (Ubuntu) Install OpenMPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'openmpi') run: | - sudo apt install -y -q openmpi-bin libopenmpi-dev hwloc fabric libhdf5-dev libhdf5-openmpi-dev hdf5-fortran + sudo apt install -y -q openmpi-bin libopenmpi-dev hwloc fabric libhdf5-dev libhdf5-openmpi-dev libhdf5-fortran - name: (Ubuntu) Install MPICH if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'mpich') run: | - sudo apt install -y -q mpich hwloc fabric libhdf5-dev libhdf5-mpich-dev hdf5-fortran + sudo apt install -y -q mpich hwloc fabric libhdf5-dev libhdf5-mpich-dev libhdf5-fortran - name: (Ubuntu) Retrieve Intel toolchain if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') From 77587c34ef66ef2397dfab904a8dc5d5164ccb91 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:45:08 +0200 Subject: [PATCH 32/46] install hdf5 for intel --- .github/workflows/meta.yml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 8f1a950a7b..d823590c57 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -108,7 +108,6 @@ jobs: wget -O- https://apt.repos.intel.com/intel-gpg-keys/GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB | gpg --dearmor | sudo tee /usr/share/keyrings/oneapi-archive-keyring.gpg > /dev/null echo "deb [signed-by=/usr/share/keyrings/oneapi-archive-keyring.gpg] https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list sudo apt-get update - sudo apt install -y -q hdf5-fortran libhdf5-dev - name: (Ubuntu) Install Intel oneAPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') @@ -120,6 +119,13 @@ jobs: run: | source /opt/intel/oneapi/setvars.sh printenv >> $GITHUB_ENV + # To run HDF5 with oneAPI, we need to build it from source + curl -O -L https://github.com/HDFGroup/hdf5/archive/refs/tags/snapshot-1.14.tar.gz + tar zxf snapshot-1.14.tar.gz + cd hdf5-snapshot-1.14 + ./configure --prefix=/tmp CC="$(which icx)" FC="$(which ifx)" --enable-build-mode=production --enable-fortran + make -j + make check -j - name: (Windows) Put MSYS2_MinGW64 on PATH if: contains(matrix.os,'windows') && (!contains(matrix.mpi,'intel')) From dd9f6aeea92e651a90c5803b82254da6390f3a0d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:46:50 +0200 Subject: [PATCH 33/46] fortran 102 --- .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 d823590c57..503b33ef1e 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -94,12 +94,12 @@ jobs: - name: (Ubuntu) Install OpenMPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'openmpi') run: | - sudo apt install -y -q openmpi-bin libopenmpi-dev hwloc fabric libhdf5-dev libhdf5-openmpi-dev libhdf5-fortran + sudo apt install -y -q openmpi-bin libopenmpi-dev hwloc fabric libhdf5-dev libhdf5-openmpi-dev libhdf5-fortran-102 - name: (Ubuntu) Install MPICH if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'mpich') run: | - sudo apt install -y -q mpich hwloc fabric libhdf5-dev libhdf5-mpich-dev libhdf5-fortran + sudo apt install -y -q mpich hwloc fabric libhdf5-dev libhdf5-mpich-dev libhdf5-fortran-102 - name: (Ubuntu) Retrieve Intel toolchain if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') From 64f9e37a3f04368a904931600657ac20fa0a0aa9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 15:54:08 +0200 Subject: [PATCH 34/46] 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 503b33ef1e..da140543e8 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -94,12 +94,12 @@ jobs: - name: (Ubuntu) Install OpenMPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'openmpi') run: | - sudo apt install -y -q openmpi-bin libopenmpi-dev hwloc fabric libhdf5-dev libhdf5-openmpi-dev libhdf5-fortran-102 + sudo apt install -y -q openmpi-bin libopenmpi-dev hwloc fabric libhdf5-dev libhdf5-fortran-102 - name: (Ubuntu) Install MPICH if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'mpich') run: | - sudo apt install -y -q mpich hwloc fabric libhdf5-dev libhdf5-mpich-dev libhdf5-fortran-102 + sudo apt install -y -q mpich hwloc fabric libhdf5-dev libhdf5-fortran-102 - name: (Ubuntu) Retrieve Intel toolchain if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') From 833e441c812176b39d7334a67bf63300a1f94e1d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 16:01:24 +0200 Subject: [PATCH 35/46] allow system flags --- .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 da140543e8..44ae23dcde 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -123,7 +123,7 @@ jobs: curl -O -L https://github.com/HDFGroup/hdf5/archive/refs/tags/snapshot-1.14.tar.gz tar zxf snapshot-1.14.tar.gz cd hdf5-snapshot-1.14 - ./configure --prefix=/tmp CC="$(which icx)" FC="$(which ifx)" --enable-build-mode=production --enable-fortran + sh ./configure --prefix=/tmp CC="$(which icx)" FC="$(which ifx)" --enable-build-mode=production --enable-fortran make -j make check -j diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index f8af06bc06..57441fb797 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1766,7 +1766,7 @@ subroutine init_hdf5(this,compiler,error) end do !> Get compiler flags - flags = pkgcfg_get_build_flags(name,.false.,error) + flags = pkgcfg_get_build_flags(name,.true.,error) if (allocated(error)) return do i=1,size(flags) From 78e86495fe20f551f0f65836d271f72f7bb11ed4 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 16:08:08 +0200 Subject: [PATCH 36/46] autogen --- .github/workflows/meta.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 44ae23dcde..ae9c32ea42 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -123,6 +123,7 @@ jobs: curl -O -L https://github.com/HDFGroup/hdf5/archive/refs/tags/snapshot-1.14.tar.gz tar zxf snapshot-1.14.tar.gz cd hdf5-snapshot-1.14 + sh ./autogen.sh sh ./configure --prefix=/tmp CC="$(which icx)" FC="$(which ifx)" --enable-build-mode=production --enable-fortran make -j make check -j From 559b9b08026f34b7d1b916817c4917c259e3a7f6 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 16:33:13 +0200 Subject: [PATCH 37/46] hdf5 *dash* fortran --- src/fpm_meta.f90 | 90 ++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 84 insertions(+), 6 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 57441fb797..388b30d8bb 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1690,20 +1690,24 @@ subroutine init_hdf5(this,compiler,error) type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error - integer :: i - logical :: s + character(*), parameter :: find_hl(*) = & + [character(11) :: '_hl_fortran','hl_fortran','_fortran','_hl'] + character(*), parameter :: candidates(5) = & + [character(15) :: 'hdf5_hl_fortran','hdf5-hl-fortran','hdf5_fortran','hdf5-fortran',& + 'hdf5_hl','hdf5','hdf5-serial'] + + integer :: i,j,k + logical :: s,found_hl(size(find_hl)) type(string_t) :: log - type(string_t), allocatable :: libs(:),flags(:),modules(:) + type(string_t), allocatable :: libs(:),flags(:),modules(:),non_fortran(:) character(len=:), allocatable :: name,module_flag,include_flag - character(*), parameter :: candidates(5) = & - [character(15) :: 'hdf5_hl_fortran','hdf5_fortran','hdf5_hl','hdf5','hdf5-serial'] module_flag = get_module_flag(compiler,"") include_flag = get_include_flag(compiler,"") !> Cleanup call destroy(this) - allocate(this%link_libs(0),this%incl_dirs(0),this%external_modules(0)) + allocate(this%link_libs(0),this%incl_dirs(0),this%external_modules(0),non_fortran(0)) this%link_flags = string_t("") this%flags = string_t("") @@ -1765,6 +1769,80 @@ subroutine init_hdf5(this,compiler,error) end if end do + ! Some pkg-config hdf5.pc (e.g. Ubuntu) don't include the commonly-used HL HDF5 libraries, + ! so let's add them if they exist + do i=1,size(this%link_libs) + + found_hl = .false. + + if (.not.str_ends_with(this%link_libs(i)%s, find_hl)) then + + finals: do k=1,size(find_hl) + do j=1,size(this%link_libs) + if (str_begins_with_str(this%link_libs(j)%s,this%link_libs(i)%s) .and. & + str_ends_with(this%link_libs(j)%s,find_hl(k))) then + found_hl(k) = .true. + cycle finals + end if + end do + end do finals + + ! For each of the missing libraries, if there is a file, + ! + + + print *, this%link_libs(i)%s,' does not end: ',found_hl + + end if + +! +! for larg in self.get_link_args(): +! lpath = Path(larg) +! # some pkg-config hdf5.pc (e.g. Ubuntu) don't include the commonly-used HL HDF5 libraries, +! # so let's add them if they exist +! # additionally, some pkgconfig HDF5 HL files are malformed so let's be sure to find HL anyway +! if lpath.is_file(): +! hl = [] +! if language == 'cpp': +! hl += ['_hl_cpp', '_cpp'] +! elif language == 'fortran': +! hl += ['_hl_fortran', 'hl_fortran', '_fortran'] +! hl += ['_hl'] # C HL library, always needed +! +! suffix = '.' + lpath.name.split('.', 1)[1] # in case of .dll.a +! for h in hl: +! hlfn = lpath.parent / (lpath.name.split('.', 1)[0] + h + suffix) +! if hlfn.is_file(): +! link_args.append(str(hlfn)) +! # HDF5 C libs are required by other HDF5 languages +! link_args.append(larg) +! else: +! link_args.append(larg) +! + + end do + +! +! # additionally, some pkgconfig HDF5 HL files are malformed so let's be sure to find HL anyway +! if lpath.is_file(): +! hl = [] +! if language == 'cpp': +! hl += ['_hl_cpp', '_cpp'] +! elif language == 'fortran': +! hl += ['_hl_fortran', 'hl_fortran', '_fortran'] +! hl += ['_hl'] # C HL library, always needed +! +! suffix = '.' + lpath.name.split('.', 1)[1] # in case of .dll.a +! for h in hl: +! hlfn = lpath.parent / (lpath.name.split('.', 1)[0] + h + suffix) +! if hlfn.is_file(): +! link_args.append(str(hlfn)) +! # HDF5 C libs are required by other HDF5 languages +! link_args.append(larg) +! else: +! link_args.append(larg) +! link_args.append(larg) + !> Get compiler flags flags = pkgcfg_get_build_flags(name,.true.,error) if (allocated(error)) return From 79d4baf4774fe5ccead949d5fca9d45bb8ab91bb Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 17:08:53 +0200 Subject: [PATCH 38/46] add missing Fortran libs for Ubuntu --- src/fpm_meta.f90 | 167 +++++++++++++++++++++++++++++++---------------- 1 file changed, 112 insertions(+), 55 deletions(-) diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 388b30d8bb..ecc64bb430 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1684,23 +1684,67 @@ subroutine filter_link_arguments(compiler,command) end subroutine filter_link_arguments +!> Given a library name and folder, find extension and prefix +subroutine lib_get_trailing(lib_name,lib_dir,prefix,suffix,found) + character(*), intent(in) :: lib_name,lib_dir + character(:), allocatable, intent(out) :: prefix,suffix + logical, intent(out) :: found + + character(*), parameter :: extensions(*) = [character(11) :: '.dll.a','.a','.dylib','.dll'] + logical :: is_file + character(:), allocatable :: noext,tokens(:),path + integer :: l,k + + ! Extract name with no extension + call split(lib_name,tokens,'.') + noext = trim(tokens(1)) + + ! Get library extension: find file name: NAME.a, NAME.dll.a, NAME.dylib, libNAME.a, etc. + found = .false. + suffix = "" + prefix = "" + with_pref: do l=1,2 + if (l==2) then + prefix = "lib" + else + prefix = "" + end if + find_ext: do k=1,size(extensions) + path = join_path(lib_dir,prefix//noext//trim(extensions(k))) + inquire(file=path,exist=is_file) + + if (is_file) then + suffix = trim(extensions(k)) + found = .true. + exit with_pref + end if + end do find_ext + end do with_pref + + if (.not.found) then + prefix = "" + suffix = "" + end if + +end subroutine lib_get_trailing + !> Initialize HDF5 metapackage for the current system subroutine init_hdf5(this,compiler,error) class(metapackage_t), intent(inout) :: this type(compiler_t), intent(in) :: compiler type(error_t), allocatable, intent(out) :: error - + character(*), parameter :: find_hl(*) = & [character(11) :: '_hl_fortran','hl_fortran','_fortran','_hl'] - character(*), parameter :: candidates(5) = & + character(*), parameter :: candidates(*) = & [character(15) :: 'hdf5_hl_fortran','hdf5-hl-fortran','hdf5_fortran','hdf5-fortran',& 'hdf5_hl','hdf5','hdf5-serial'] - integer :: i,j,k - logical :: s,found_hl(size(find_hl)) - type(string_t) :: log + integer :: i,j,k,l + logical :: s,found_hl(size(find_hl)),found + type(string_t) :: log,this_lib type(string_t), allocatable :: libs(:),flags(:),modules(:),non_fortran(:) - character(len=:), allocatable :: name,module_flag,include_flag + character(len=:), allocatable :: name,module_flag,include_flag,libdir,ext,pref module_flag = get_module_flag(compiler,"") include_flag = get_include_flag(compiler,"") @@ -1752,6 +1796,8 @@ subroutine init_hdf5(this,compiler,error) !> Get libraries libs = pkgcfg_get_libs(name,error) if (allocated(error)) return + + libdir = "" do i=1,size(libs) if (str_begins_with_str(libs(i)%s,'-l')) then @@ -1760,66 +1806,77 @@ subroutine init_hdf5(this,compiler,error) print *, 'HDF5: add link library '//libs(i)%s(3:) - else ! -L and other: concatenate + else ! -L and others: concatenate this%has_link_flags = .true. this%link_flags = string_t(trim(this%link_flags%s)//' '//libs(i)%s) + + ! Also save library dir + if (str_begins_with_str(libs(i)%s,'-L')) then + libdir = libs(i)%s(3:) + elseif (str_begins_with_str(libs(i)%s,'/LIBPATH')) then + libdir = libs(i)%s(9:) + endif print *, 'HDF5: add link flag '//libs(i)%s end if end do + print *, 'libdir = ',libdir + do i=1,size(this%link_libs) + print *, '-l'//this%link_libs(i)%s + end do + + ! Some pkg-config hdf5.pc (e.g. Ubuntu) don't include the commonly-used HL HDF5 libraries, ! so let's add them if they exist - do i=1,size(this%link_libs) - - found_hl = .false. - - if (.not.str_ends_with(this%link_libs(i)%s, find_hl)) then + if (len_trim(libdir)>0) then + do i=1,size(this%link_libs) - finals: do k=1,size(find_hl) - do j=1,size(this%link_libs) - if (str_begins_with_str(this%link_libs(j)%s,this%link_libs(i)%s) .and. & - str_ends_with(this%link_libs(j)%s,find_hl(k))) then - found_hl(k) = .true. - cycle finals - end if - end do - end do finals - - ! For each of the missing libraries, if there is a file, - ! - - - print *, this%link_libs(i)%s,' does not end: ',found_hl - - end if - -! -! for larg in self.get_link_args(): -! lpath = Path(larg) -! # some pkg-config hdf5.pc (e.g. Ubuntu) don't include the commonly-used HL HDF5 libraries, -! # so let's add them if they exist -! # additionally, some pkgconfig HDF5 HL files are malformed so let's be sure to find HL anyway -! if lpath.is_file(): -! hl = [] -! if language == 'cpp': -! hl += ['_hl_cpp', '_cpp'] -! elif language == 'fortran': -! hl += ['_hl_fortran', 'hl_fortran', '_fortran'] -! hl += ['_hl'] # C HL library, always needed -! -! suffix = '.' + lpath.name.split('.', 1)[1] # in case of .dll.a -! for h in hl: -! hlfn = lpath.parent / (lpath.name.split('.', 1)[0] + h + suffix) -! if hlfn.is_file(): -! link_args.append(str(hlfn)) -! # HDF5 C libs are required by other HDF5 languages -! link_args.append(larg) -! else: -! link_args.append(larg) -! - + found_hl = .false. + + if (.not.str_ends_with(this%link_libs(i)%s, find_hl)) then + + ! Extract name with no extension + call lib_get_trailing(this%link_libs(i)%s, libdir, pref, ext, found) + + ! Search how many versions with the Fortran endings there are + finals: do k=1,size(find_hl) + do j=1,size(this%link_libs) + print *, this%link_libs(j)%s,' begins? ',str_begins_with_str(this%link_libs(j)%s,this%link_libs(i)%s), & + ' ends? ',str_ends_with(this%link_libs(j)%s,trim(find_hl(k))) + if (str_begins_with_str(this%link_libs(j)%s,this%link_libs(i)%s) .and. & + str_ends_with(this%link_libs(j)%s,trim(find_hl(k)))) then + found_hl(k) = .true. + cycle finals + end if + end do + end do finals + + print *, 'lib ',this%link_libs(i)%s,' found = ',found_hl + + ! For each of the missing ones, if there is a file, add it + add_missing: do k=1,size(find_hl) + if (found_hl(k)) cycle add_missing + + ! Build file name + this_lib%s = join_path(libdir,pref//this%link_libs(i)%s//trim(find_hl(k))//ext) + inquire(file=this_lib%s,exist=found) + + ! File exists, but it is not linked against + if (found) this%link_libs = [this%link_libs, & + string_t(this%link_libs(i)%s//trim(find_hl(k)))] + + end do add_missing + + end if + + end do + endif + + print *, 'final link libs: ' + do i=1,size(this%link_libs) + print *, '-l'//this%link_libs(i)%s end do ! From f7944e0a7105fbae2b3592f599f15974a24af58d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 17:12:43 +0200 Subject: [PATCH 39/46] do not test oneAPI + HDF5 (cannot build) --- ci/meta_tests.sh | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/ci/meta_tests.sh b/ci/meta_tests.sh index d9749bb511..4cd9bbb921 100755 --- a/ci/meta_tests.sh +++ b/ci/meta_tests.sh @@ -42,10 +42,14 @@ pushd metapackage_mpi_c "$fpm" run --verbose popd -pushd metapackage_hdf5 -"$fpm" build --verbose -"$fpm" run --verbose -popd + +# ifx cannot currently build the HDF5 library +if [ ! "$FPM_FC" == "ifx" ]; then + pushd metapackage_hdf5 + "$fpm" build --verbose + "$fpm" run --verbose + popd +fi # Cleanup rm -rf ./*/build From d58ddf66310f79baefa49cf826e5164a1fb07358 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 17:18:16 +0200 Subject: [PATCH 40/46] oneAPI: upgrade to 2024.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 ae9c32ea42..b7238d8de0 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -112,7 +112,7 @@ jobs: - name: (Ubuntu) Install Intel oneAPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') timeout-minutes: 15 - run: sudo apt-get install intel-oneapi-compiler-dpcpp-cpp-2023.1.0 intel-oneapi-compiler-fortran-2023.1.0 intel-oneapi-mpi-devel ninja-build + run: sudo apt-get install intel-oneapi-compiler-dpcpp-cpp-2024.1.0 intel-oneapi-compiler-fortran-2024.1.0 intel-oneapi-mpi-devel ninja-build - name: (Ubuntu) Setup Intel oneAPI environment if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') From 6409604a50a11c6be9271cd4a15020d7a43f2d9d Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 17:32:37 +0200 Subject: [PATCH 41/46] update oneAPI key --- .github/workflows/meta.yml | 2 +- src/fpm_meta.f90 | 21 --------------------- 2 files changed, 1 insertion(+), 22 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index b7238d8de0..c402683350 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -112,7 +112,7 @@ jobs: - name: (Ubuntu) Install Intel oneAPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') timeout-minutes: 15 - run: sudo apt-get install intel-oneapi-compiler-dpcpp-cpp-2024.1.0 intel-oneapi-compiler-fortran-2024.1.0 intel-oneapi-mpi-devel ninja-build + run: sudo apt-get install intel-oneapi-compiler-dpcpp-cpp-2024.1.0-963 intel-oneapi-compiler-fortran-2024.1.0-963 intel-oneapi-mpi-devel ninja-build - name: (Ubuntu) Setup Intel oneAPI environment if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index ecc64bb430..59d205970d 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -1879,27 +1879,6 @@ subroutine init_hdf5(this,compiler,error) print *, '-l'//this%link_libs(i)%s end do -! -! # additionally, some pkgconfig HDF5 HL files are malformed so let's be sure to find HL anyway -! if lpath.is_file(): -! hl = [] -! if language == 'cpp': -! hl += ['_hl_cpp', '_cpp'] -! elif language == 'fortran': -! hl += ['_hl_fortran', 'hl_fortran', '_fortran'] -! hl += ['_hl'] # C HL library, always needed -! -! suffix = '.' + lpath.name.split('.', 1)[1] # in case of .dll.a -! for h in hl: -! hlfn = lpath.parent / (lpath.name.split('.', 1)[0] + h + suffix) -! if hlfn.is_file(): -! link_args.append(str(hlfn)) -! # HDF5 C libs are required by other HDF5 languages -! link_args.append(larg) -! else: -! link_args.append(larg) -! link_args.append(larg) - !> Get compiler flags flags = pkgcfg_get_build_flags(name,.true.,error) if (allocated(error)) return From 0f9b5b6a58f1cce990f9a93ca7038aa570b843b4 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 17:41:09 +0200 Subject: [PATCH 42/46] oneAPI -> setup-fortran --- .github/workflows/meta.yml | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index c402683350..c70753cd9d 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -111,14 +111,15 @@ jobs: - name: (Ubuntu) Install Intel oneAPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') - timeout-minutes: 15 - run: sudo apt-get install intel-oneapi-compiler-dpcpp-cpp-2024.1.0-963 intel-oneapi-compiler-fortran-2024.1.0-963 intel-oneapi-mpi-devel ninja-build + uses: fortran-lang/setup-fortran@v1.6.1 + id: setup-fortran + with: + compiler: intel + version: 2024.1.0 - - name: (Ubuntu) Setup Intel oneAPI environment + - name: (Ubuntu) Build HDF5 for oneAPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') run: | - source /opt/intel/oneapi/setvars.sh - printenv >> $GITHUB_ENV # To run HDF5 with oneAPI, we need to build it from source curl -O -L https://github.com/HDFGroup/hdf5/archive/refs/tags/snapshot-1.14.tar.gz tar zxf snapshot-1.14.tar.gz From dcac4bbcbb171bd1dae03965dd50f4f928b6cfd4 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 17:51:12 +0200 Subject: [PATCH 43/46] reinstate HDF5+oneAPI test --- .github/workflows/meta.yml | 2 +- ci/meta_tests.sh | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index c70753cd9d..393335914d 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -117,7 +117,7 @@ jobs: compiler: intel version: 2024.1.0 - - name: (Ubuntu) Build HDF5 for oneAPI + - name: (Ubuntu) finalize oneAPI environment if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') run: | # To run HDF5 with oneAPI, we need to build it from source diff --git a/ci/meta_tests.sh b/ci/meta_tests.sh index 4cd9bbb921..7ec707e0e9 100755 --- a/ci/meta_tests.sh +++ b/ci/meta_tests.sh @@ -44,12 +44,12 @@ popd # ifx cannot currently build the HDF5 library -if [ ! "$FPM_FC" == "ifx" ]; then +# if [ ! "$FPM_FC" == "ifx" ]; then pushd metapackage_hdf5 "$fpm" build --verbose "$fpm" run --verbose popd -fi +#fi # Cleanup rm -rf ./*/build From be7852246b86501fefb65974350db898732e2f6b Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Mon, 24 Jun 2024 17:52:14 +0200 Subject: [PATCH 44/46] oneAPI from setup-fortran; HDF5 download+CMake; remove `standard-semantics` flags --- .github/workflows/meta.yml | 16 ++++++++++------ src/fpm/manifest/profiles.f90 | 18 +++++++++--------- src/fpm_compiler.F90 | 22 ++++++---------------- test/fpm_test/test_manifest.f90 | 2 +- 4 files changed, 26 insertions(+), 32 deletions(-) diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 393335914d..411437d6b8 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -120,14 +120,18 @@ jobs: - name: (Ubuntu) finalize oneAPI environment if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') run: | - # To run HDF5 with oneAPI, we need to build it from source + # Install MPI + sudo apt-get install -y -q intel-oneapi-mpi-devel ninja-build cmake + source /opt/intel/oneapi/setvars.sh --force + printenv >> $GITHUB_ENV + # To run HDF5 with oneAPI, we need to build it from source. Use CMake to generate pkg-config info curl -O -L https://github.com/HDFGroup/hdf5/archive/refs/tags/snapshot-1.14.tar.gz tar zxf snapshot-1.14.tar.gz cd hdf5-snapshot-1.14 - sh ./autogen.sh - sh ./configure --prefix=/tmp CC="$(which icx)" FC="$(which ifx)" --enable-build-mode=production --enable-fortran + cmake -B build -DCMAKE_Fortran_COMPILER=ifx -DCMAKE_C_COMPILER=icx -DCMAKE_CXX_COMPILER=icpx -DHDF5_BUILD_FORTRAN=ON -DCMAKE_INSTALL_PREFIX=/usr + cd build make -j - make check -j + sudo make install - name: (Windows) Put MSYS2_MinGW64 on PATH if: contains(matrix.os,'windows') && (!contains(matrix.mpi,'intel')) @@ -224,8 +228,8 @@ jobs: mv $(which fpm) fpm-bootstrap${{ matrix.exe }} echo "BOOTSTRAP=$PWD/fpm-bootstrap" >> $GITHUB_ENV - - name: (macOS) Use gcc/g++ instead of Clang for C/C++ - if: contains(matrix.os,'macOS') + - name: (macOS/Ubuntu) Use gcc/g++ instead of Clang for C/C++ / ifx to build fpm + if: contains(matrix.os,'macOS') || contains(matrix.os,'ubuntu') shell: bash run: | echo "FPM_FC=gfortran-${{ env.GCC_V }}" >> $GITHUB_ENV diff --git a/src/fpm/manifest/profiles.f90 b/src/fpm/manifest/profiles.f90 index f50cf32cff..6b139910d9 100644 --- a/src/fpm/manifest/profiles.f90 +++ b/src/fpm/manifest/profiles.f90 @@ -749,25 +749,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 -standard-semantics', & + & threaded -nogen-interfaces -assume byterecl', & & is_built_in=.true.), & & new_profile('release', & & 'ifort', & & OS_WINDOWS, & & flags = ' /fp:precise /align:all /error-limit:1 /reentrancy:threaded& - & /nogen-interfaces /assume:byterecl /standard-semantics', & + & /nogen-interfaces /assume:byterecl', & & 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 -standard-semantics', & + & threaded -nogen-interfaces -assume byterecl', & & is_built_in=.true.), & & new_profile('release', & & 'ifx', & & OS_WINDOWS, & & flags = ' /fp:precise /align:all /error-limit:1 /reentrancy:threaded& - & /nogen-interfaces /assume:byterecl /standard-semantics', & + & /nogen-interfaces /assume:byterecl', & & is_built_in=.true.), & & new_profile('release', & &'nagfor', & @@ -805,28 +805,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 -standard-semantics -traceback', & + & flags = ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -traceback', & & is_built_in=.true.), & & new_profile('debug', & & 'ifort', & & OS_WINDOWS, & & flags = ' /warn:all /check:all /error-limit:1& - & /Od /Z7 /assume:byterecl /standard-semantics /traceback', & + & /Od /Z7 /assume:byterecl /traceback', & & is_built_in=.true.), & & new_profile('debug', & & 'ifx', & & OS_ALL, & - & flags = ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -standard-semantics -traceback', & + & flags = ' -warn all -check all -error-limit 1 -O0 -g -assume byterecl -traceback', & & is_built_in=.true.), & & new_profile('debug', & & 'ifx', & & OS_WINDOWS, & - & flags = ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl /standard-semantics', & + & flags = ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl', & & is_built_in=.true.), & & new_profile('debug', & & 'ifx', & & OS_WINDOWS, & - & flags = ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl /standard-semantics', & + & flags = ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl', & & is_built_in=.true.), & & new_profile('debug', & & 'lfortran', & diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index 718843a3eb..5928ee2fd1 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -309,8 +309,7 @@ subroutine get_release_compile_flags(id, flags) flag_intel_limit//& flag_intel_pthread//& flag_intel_nogen//& - flag_intel_byterecl//& - flag_intel_standard_compliance + flag_intel_byterecl case(id_intel_classic_mac) flags = & @@ -320,8 +319,7 @@ subroutine get_release_compile_flags(id, flags) flag_intel_limit//& flag_intel_pthread//& flag_intel_nogen//& - flag_intel_byterecl//& - flag_intel_standard_compliance + flag_intel_byterecl case(id_intel_classic_windows) flags = & @@ -331,8 +329,7 @@ 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_standard_compliance_win + flag_intel_byterecl_win case(id_intel_llvm_nix) flags = & @@ -342,8 +339,7 @@ subroutine get_release_compile_flags(id, flags) flag_intel_limit//& flag_intel_pthread//& flag_intel_nogen//& - flag_intel_byterecl//& - flag_intel_standard_compliance + flag_intel_byterecl case(id_intel_llvm_windows) flags = & @@ -353,8 +349,7 @@ 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_standard_compliance_win + flag_intel_byterecl_win case(id_nag) flags = & @@ -418,7 +413,6 @@ 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) @@ -428,7 +422,6 @@ 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 = & @@ -437,7 +430,6 @@ 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 = & @@ -446,7 +438,6 @@ 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 = & @@ -454,8 +445,7 @@ 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_standard_compliance_win + flag_intel_byterecl_win case(id_nag) flags = & flag_nag_debug//& diff --git a/test/fpm_test/test_manifest.f90 b/test/fpm_test/test_manifest.f90 index ddabe3cf49..316508d9bc 100644 --- a/test/fpm_test/test_manifest.f90 +++ b/test/fpm_test/test_manifest.f90 @@ -556,7 +556,7 @@ subroutine test_profiles(error) 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 /standard-semantics /traceback')) then + ' /warn:all /check:all /error-limit:1 /Od /Z7 /assume:byterecl /traceback')) then call test_failed(error, "Failed to load built-in profile "//profile_name) return end if From d638a735d17627b216615e178b68c89d4b840e91 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Fri, 12 Jul 2024 09:01:45 +0200 Subject: [PATCH 45/46] cleanup --- ci/meta_tests.sh | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/ci/meta_tests.sh b/ci/meta_tests.sh index 7ec707e0e9..d9749bb511 100755 --- a/ci/meta_tests.sh +++ b/ci/meta_tests.sh @@ -42,14 +42,10 @@ pushd metapackage_mpi_c "$fpm" run --verbose popd - -# ifx cannot currently build the HDF5 library -# if [ ! "$FPM_FC" == "ifx" ]; then - pushd metapackage_hdf5 - "$fpm" build --verbose - "$fpm" run --verbose - popd -#fi +pushd metapackage_hdf5 +"$fpm" build --verbose +"$fpm" run --verbose +popd # Cleanup rm -rf ./*/build From f79f48c2bd5e6271a2ed3b767ec8c74fb0e3b003 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 16 Jul 2024 18:45:16 +0200 Subject: [PATCH 46/46] CI: use macos 12 --- .github/workflows/CI.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 778f8f40da..993a5ee729 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -21,14 +21,14 @@ jobs: strategy: fail-fast: false matrix: - os: [ubuntu-latest, macos-11, windows-latest] + os: [ubuntu-latest, macos-12, windows-latest] gcc_v: [10,11,12] # 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: macos-12 os-arch: macos-x86_64 release-flags: --flag '-g -fbacktrace -O3'