diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 5deae0c166..192214e373 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -35,8 +35,6 @@ jobs: mpi: openmpi - os: ubuntu-latest mpi: mpich - - os: windows-latest - mpi: msmpi - os: macos-latest mpi: openmpi - os: macos-latest @@ -106,16 +104,14 @@ jobs: if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') timeout-minutes: 1 run: | - wget https://apt.repos.intel.com/intel-gpg-keys/GPG-PUB-KEY-INTEL-SW-PRODUCTS-2023.PUB - sudo apt-key add GPG-PUB-KEY-INTEL-SW-PRODUCTS-2023.PUB - rm GPG-PUB-KEY-INTEL-SW-PRODUCTS-2023.PUB - echo "deb https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list + 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 - name: (Ubuntu) Install Intel oneAPI if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') - timeout-minutes: 5 - run: sudo apt-get install intel-oneapi-compiler-fortran intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic intel-oneapi-mpi intel-oneapi-mpi-devel intel-oneapi-mkl ninja-build + 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 - name: (Ubuntu) Setup Intel oneAPI environment if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'intel') @@ -152,6 +148,7 @@ jobs: if: contains(matrix.os,'windows') && contains(matrix.mpi,'msmpi') run: | echo "C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append + echo "/c/Program Files/Microsoft MPI/Bin/" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append echo "MSMPI_BIN=C:\Program Files\Microsoft MPI\Bin\" | Out-File -FilePath $env:GITHUB_ENV -Append - name: (Windows) load OneAPI environment variables @@ -216,9 +213,9 @@ jobs: if: contains(matrix.mpi,'intel') shell: bash run: | - echo "FPM_FC=ifort" >> $GITHUB_ENV - echo "FPM_CC=icc" >> $GITHUB_ENV - echo "FPM_CXX=icpc" >> $GITHUB_ENV + echo "FPM_FC=ifx" >> $GITHUB_ENV + echo "FPM_CC=icx" >> $GITHUB_ENV + echo "FPM_CXX=icpx" >> $GITHUB_ENV - name: (macOS) Use gcc/g++ instead of Clang for C/C++ if: contains(matrix.os,'macOS') diff --git a/fpm.toml b/fpm.toml index 1da1a00dcf..3956e42105 100644 --- a/fpm.toml +++ b/fpm.toml @@ -18,6 +18,8 @@ fortran-regex.git = "https://github.com/perazz/fortran-regex" fortran-regex.tag = "1.1.2" jonquil.git = "https://github.com/toml-f/jonquil" jonquil.rev = "4fbd4cf34d577c0fd25e32667ee9e41bf231ece8" +fortran-shlex.git = "https://github.com/perazz/fortran-shlex" +fortran-shlex.tag = "1.0.1" [[test]] name = "cli-test" diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index b93c092f4a..55565ee31d 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -185,6 +185,9 @@ module fpm_compiler flag_intel_fixed_form = " -fixed", & flag_intel_standard_compliance = " -standard-semantics" +character(*), parameter :: & + flag_intel_llvm_check = " -check all,nouninit" + character(*), parameter :: & flag_intel_backtrace_win = " /traceback", & flag_intel_warn_win = " /warn:all", & @@ -421,7 +424,7 @@ subroutine get_debug_compile_flags(id, flags) case(id_intel_llvm_nix) flags = & flag_intel_warn//& - flag_intel_check//& + flag_intel_llvm_check//& flag_intel_limit//& flag_intel_debug//& flag_intel_byterecl//& diff --git a/src/fpm_environment.f90 b/src/fpm_environment.f90 index 7e8aa2317d..839fb17869 100644 --- a/src/fpm_environment.f90 +++ b/src/fpm_environment.f90 @@ -36,11 +36,11 @@ integer function get_os_type() result(r) !! found on specific system types only. !! !! Returns OS_UNKNOWN if the operating system cannot be determined. - character(len=32) :: val - integer :: length, rc - logical :: file_exists - logical, save :: first_run = .true. - integer, save :: ret = OS_UNKNOWN + character(len=255) :: val + integer :: length, rc + logical :: file_exists + logical, save :: first_run = .true. + integer, save :: ret = OS_UNKNOWN !$omp threadprivate(ret, first_run) if (.not. first_run) then diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 177ee85fea..ca521346b3 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -654,7 +654,7 @@ end function unix_path !! integer :: iostat !! character(len=:),allocatable :: line, iomsg !! open(unit=stdin,pad='yes') -!! INFINITE: do +!! INFINITE: do !! call getline(stdin,line,iostat,iomsg) !! if(iostat /= 0) exit INFINITE !! write(*,'(a)')'['//line//']' diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index 827af3ca3c..3265b26e47 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -3,21 +3,22 @@ !> This is a wrapper data type that encapsulate all pre-processing information !> (compiler flags, linker libraries, etc.) required to correctly enable a package !> to use a core library. -!> !> -!>### Available core libraries +!> +!>### Available core libraries !> !> - OpenMP !> - MPI !> - fortran-lang stdlib !> - fortran-lang minpack -!> +!> !> !> @note Core libraries are enabled in the [build] section of the fpm.toml manifest !> !> module fpm_meta -use fpm_strings, only: string_t, len_trim, remove_newline_characters +use fpm_strings, only: string_t, len_trim, remove_newline_characters, str_begins_with_str, & + str_ends_with use fpm_error, only: error_t, fatal_error, syntax_error, fpm_stop use fpm_compiler use fpm_model @@ -29,6 +30,8 @@ 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 shlex_module, only: shlex_split => split +use regex_module, only: regex use iso_fortran_env, only: stdout => output_unit implicit none @@ -106,6 +109,8 @@ module fpm_meta integer, parameter, private :: LANG_C = 2 integer, parameter, private :: LANG_CXX = 3 +character(*), parameter :: LANG_NAME(*) = [character(7) :: 'Fortran','C','C++'] + contains !> Return a name for the MPI library @@ -434,10 +439,8 @@ subroutine resolve_metapackage_model(model,package,settings,error) ! Dependencies are added to the package config, so they're properly resolved ! into the dependency tree later. ! Flags are added to the model (whose compiler needs to be already initialized) - if (model%compiler%is_unknown()) then - call fatal_error(error,"compiler not initialized: cannot build metapackages") - return - end if + if (model%compiler%is_unknown()) & + write(stdout,'(a)') ' compiler not initialized: metapackages may not be available' ! OpenMP if (package%meta%openmp%on) then @@ -634,7 +637,13 @@ logical function msmpi_init(this,compiler,error) result(found) call get_absolute_path('C:\Program Files\Microsoft MPI\Bin\mpiexec.exe',bindir,error) endif - ! Do a third attempt: search for mpiexec.exe in PATH location + ! Third attempt for bash-style shell + if (len_trim(bindir)<=0 .or. allocated(error)) then + if (verbose) print *, '+ %MSMPI_BIN% empty, searching /c/Program Files/Microsoft MPI/Bin/ ...' + call get_absolute_path('/c/Program Files/Microsoft MPI/Bin/mpiexec.exe',bindir,error) + endif + + ! Do a fourth attempt: search for mpiexec.exe in PATH location if (len_trim(bindir)<=0 .or. allocated(error)) then if (verbose) print *, '+ C:\Program Files\Microsoft MPI\Bin\ not found. searching %PATH%...' @@ -647,7 +656,7 @@ logical function msmpi_init(this,compiler,error) result(found) endif - if (allocated(error) .or. .not.exists(bindir)) then + if (allocated(error)) then call fatal_error(error,'MS-MPI error: MS-MPI Runtime directory is missing. '//& 'check environment variable %MSMPI_BIN% or that the folder is in %PATH%.') return @@ -983,28 +992,25 @@ subroutine init_mpi_from_wrappers(this,compiler,mpilib,fort_wrapper,c_wrapper,cx call destroy(this) ! Get linking flags - if (mpilib/=MPI_TYPE_INTEL) then - this%link_flags = mpi_wrapper_query(mpilib,fort_wrapper,'link',verbose,error) + this%link_flags = mpi_wrapper_query(mpilib,fort_wrapper,'link',verbose,error) + if (allocated(error)) return - ! We fix OpenMPI's Fortran wrapper bug (https://github.com/open-mpi/ompi/issues/11636) - !call fix_openmpi_link_flags(this%link_flags,compiler,mpilib,fort_wrapper,c_wrapper,cxx_wrapper,error) + ! Remove useless/dangerous flags + call filter_link_arguments(compiler,this%link_flags) - if (allocated(error)) return - this%has_link_flags = len_trim(this%link_flags)>0 - endif + this%has_link_flags = len_trim(this%link_flags)>0 ! Request to use libs in arbitrary order if (this%has_link_flags .and. compiler%is_gnu() .and. os_is_unix() .and. get_os_type()/=OS_MACOS) then this%link_flags = string_t(' -Wl,--start-group '//this%link_flags%s) end if - ! Add language-specific flags - call set_language_flags(mpilib,fort_wrapper,this%has_fortran_flags,this%fflags,verbose,error) + call set_language_flags(compiler,mpilib,fort_wrapper,this%has_fortran_flags,this%fflags,verbose,error) if (allocated(error)) return - call set_language_flags(mpilib,c_wrapper,this%has_c_flags,this%cflags,verbose,error) + call set_language_flags(compiler,mpilib,c_wrapper,this%has_c_flags,this%cflags,verbose,error) if (allocated(error)) return - call set_language_flags(mpilib,cxx_wrapper,this%has_cxx_flags,this%cxxflags,verbose,error) + call set_language_flags(compiler,mpilib,cxx_wrapper,this%has_cxx_flags,this%cxxflags,verbose,error) if (allocated(error)) return ! Get library version @@ -1021,7 +1027,8 @@ subroutine init_mpi_from_wrappers(this,compiler,mpilib,fort_wrapper,c_wrapper,cx contains - subroutine set_language_flags(mpilib,wrapper,has_flags,flags,verbose,error) + subroutine set_language_flags(compiler,mpilib,wrapper,has_flags,flags,verbose,error) + type(compiler_t), intent(in) :: compiler integer, intent(in) :: mpilib type(string_t), intent(in) :: wrapper logical, intent(inout) :: has_flags @@ -1041,6 +1048,8 @@ subroutine set_language_flags(mpilib,wrapper,has_flags,flags,verbose,error) if (verbose) print *, '+ MPI language flags from wrapper <',wrapper%s,'>: flags=',flags%s + call filter_build_arguments(compiler,flags) + endif end subroutine set_language_flags @@ -1055,13 +1064,16 @@ subroutine mpi_compiler_match(language,wrappers,compiler,which_one,mpilib,error) integer, intent(out) :: which_one, mpilib type(error_t), allocatable, intent(out) :: error - integer :: i + integer :: i, same_vendor, vendor_mpilib type(string_t) :: screen character(128) :: msg_out type(compiler_t) :: mpi_compiler - which_one = 0 - mpilib = MPI_TYPE_NONE + which_one = 0 + same_vendor = 0 + mpilib = MPI_TYPE_NONE + + if (verbose) print *, '+ Trying to match available ',LANG_NAME(language),' MPI wrappers to ',compiler%fc,'...' do i=1,size(wrappers) @@ -1070,6 +1082,8 @@ subroutine mpi_compiler_match(language,wrappers,compiler,which_one,mpilib,error) screen = mpi_wrapper_query(mpilib,wrappers(i),'compiler',verbose=.false.,error=error) if (allocated(error)) return + if (verbose) print *, ' Wrapper ',wrappers(i)%s,' lib=',MPI_TYPE_NAME(mpilib),' uses ',screen%s + select case (language) case (LANG_FORTRAN) ! Build compiler type. The ID is created based on the Fortran name @@ -1080,7 +1094,6 @@ subroutine mpi_compiler_match(language,wrappers,compiler,which_one,mpilib,error) which_one = i return end if - case (LANG_C) ! For other languages, we can only hope that the name matches the expected one if (screen%s==compiler%cc .or. screen%s==compiler%fc) then @@ -1094,8 +1107,20 @@ subroutine mpi_compiler_match(language,wrappers,compiler,which_one,mpilib,error) end if end select + ! Because the intel mpi library does not support llvm_ compiler wrappers yet, + ! we must check for that manually + if (is_intel_classic_option(language,same_vendor,screen,compiler,mpi_compiler)) then + same_vendor = i + vendor_mpilib = mpilib + end if end do + ! Intel compiler: if an exact match is not found, attempt closest wrapper + if (which_one==0 .and. same_vendor>0) then + which_one = same_vendor + mpilib = vendor_mpilib + end if + ! None of the available wrappers matched the current Fortran compiler write(msg_out,1) size(wrappers),compiler%fc call fatal_error(error,trim(msg_out)) @@ -1103,6 +1128,28 @@ subroutine mpi_compiler_match(language,wrappers,compiler,which_one,mpilib,error) end subroutine mpi_compiler_match +!> Because the Intel mpi library does not support llvm_ compiler wrappers yet, +!> we must save the Intel-classic option and later manually replace it +logical function is_intel_classic_option(language,same_vendor_ID,screen_out,compiler,mpi_compiler) + integer, intent(in) :: language,same_vendor_ID + type(string_t), intent(in) :: screen_out + type(compiler_t), intent(in) :: compiler,mpi_compiler + + if (same_vendor_ID/=0) then + is_intel_classic_option = .false. + else + select case (language) + case (LANG_FORTRAN) + is_intel_classic_option = mpi_compiler%is_intel() .and. compiler%is_intel() + case (LANG_C) + is_intel_classic_option = screen_out%s=='icc' .and. compiler%cc=='icx' + case (LANG_CXX) + is_intel_classic_option = screen_out%s=='icpc' .and. compiler%cc=='icpx' + end select + end if + +end function is_intel_classic_option + !> Return library version from the MPI wrapper command type(version_t) function mpi_version_get(mpilib,wrapper,error) integer, intent(in) :: mpilib @@ -1395,6 +1442,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) end if ! Take out the first command from the whole line + call remove_newline_characters(screen) call split(screen%s,tokens,delimiters=' ') screen%s = trim(adjustl(tokens(1))) @@ -1441,6 +1489,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) select case (mpilib) case (MPI_TYPE_OPENMPI); cmdstr = string_t('--showme:link') case (MPI_TYPE_MPICH); cmdstr = string_t('-link-info') + case (MPI_TYPE_INTEL); cmdstr = string_t('-show') case default call fatal_error(error,unsupported_msg) return @@ -1458,7 +1507,7 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) select case (mpilib) case (MPI_TYPE_OPENMPI) call remove_newline_characters(screen) - case (MPI_TYPE_MPICH) + case (MPI_TYPE_MPICH,MPI_TYPE_INTEL) ! MPICH reports the full command including the compiler name. Remove it if so call remove_newline_characters(screen) call split(screen%s,tokens) @@ -1598,4 +1647,123 @@ type(string_t) function mpi_wrapper_query(mpilib,wrapper,command,verbose,error) end function mpi_wrapper_query +!> Check if input is a useful linker argument +logical function is_link_argument(compiler,string) + type(compiler_t), intent(in) :: compiler + character(*), intent(in) :: string + + select case (compiler%id) + case (id_intel_classic_windows,id_intel_llvm_windows) + is_link_argument = string=='/link' & + .or. str_begins_with_str(string,'/LIBPATH')& + .or. str_ends_with(string,'.lib') ! always .lib whether static or dynamic + case default + + ! fix OpenMPI's Fortran wrapper bug (https://github.com/open-mpi/ompi/issues/11636) here + is_link_argument = ( str_begins_with_str(string,'-L') & + .or. str_begins_with_str(string,'-l') & + .or. str_begins_with_str(string,'-Xlinker') & + .or. string=='-pthread' & + .or. (str_begins_with_str(string,'-W') .and. & + (string/='-Wall') .and. (.not.str_begins_with_str(string,'-Werror'))) ) & + .and. .not. ( & + (get_os_type()==OS_MACOS .and. index(string,'-commons,use_dylibs')>0) ) + end select + +end function is_link_argument + +!> From build, remove optimization and other unnecessary flags +subroutine filter_build_arguments(compiler,command) + type(compiler_t), intent(in) :: compiler + type(string_t), intent(inout) :: command + character(len=:), allocatable :: tokens(:) + + integer :: i,n,re_i,re_l + logical, allocatable :: keep(:) + logical :: keep_next + character(len=:), allocatable :: module_flag,include_flag + + if (len_trim(command)<=0) return + + ! Split command into arguments + tokens = shlex_split(command%s) + + module_flag = get_module_flag(compiler,"") + include_flag = get_include_flag(compiler,"") + + n = size(tokens) + allocate(keep(n),source=.false.) + keep_next = .false. + + do i=1,n + + if (get_os_type()==OS_MACOS .and. index(tokens(i),'-commons,use_dylibs')>0) then + keep(i) = .false. + keep_next = .false. + elseif (str_begins_with_str(tokens(i),'-D') .or. & + str_begins_with_str(tokens(i),'-f') .or. & + str_begins_with_str(tokens(i),'-I') .or. & + str_begins_with_str(tokens(i),module_flag) .or. & + str_begins_with_str(tokens(i),include_flag) .or. & + tokens(i)=='-pthread' .or. & + (str_begins_with_str(tokens(i),'-W') .and. tokens(i)/='-Wall' .and. .not.str_begins_with_str(tokens(i),'-Werror')) & + ) then + keep(i) = .true. + if (tokens(i)==module_flag .or. tokens(i)==include_flag .or. tokens(i)=='-I') keep_next = .true. + elseif (keep_next) then + keep(i) = .true. + keep_next = .false. + end if + end do + + ! Backfill + command = string_t("") + do i=1,n + if (.not.keep(i)) cycle + + command%s = command%s//' '//trim(tokens(i)) + end do + + +end subroutine filter_build_arguments + +!> From the linker flags, remove optimization and other unnecessary flags +subroutine filter_link_arguments(compiler,command) + type(compiler_t), intent(in) :: compiler + type(string_t), intent(inout) :: command + character(len=:), allocatable :: tokens(:) + + integer :: i,n + logical, allocatable :: keep(:) + logical :: keep_next + + if (len_trim(command)<=0) return + + ! Split command into arguments + tokens = shlex_split(command%s) + + n = size(tokens) + allocate(keep(n),source=.false.) + keep_next = .false. + + do i=1,n + if (is_link_argument(compiler,tokens(i))) then + keep(i) = .true. + if (tokens(i)=='-L' .or. tokens(i)=='-Xlinker') keep_next = .true. + elseif (keep_next) then + keep(i) = .true. + keep_next = .false. + end if + end do + + ! Backfill + command = string_t("") + do i=1,n + if (.not.keep(i)) cycle + command%s = command%s//' '//trim(tokens(i)) + end do + +end subroutine filter_link_arguments + + end module fpm_meta