diff --git a/src/fpm_compiler.F90 b/src/fpm_compiler.F90 index 24145ac93b..523a805bfb 100644 --- a/src/fpm_compiler.F90 +++ b/src/fpm_compiler.F90 @@ -139,6 +139,12 @@ module fpm_compiler procedure :: check_flags_supported procedure :: with_xdp procedure :: with_qp + !> C feature support + procedure :: check_c_source_runs + procedure :: check_c_flags_supported + !> C++ feature support + procedure :: check_cxx_source_runs + procedure :: check_cxx_flags_supported !> Return compiler name procedure :: name => compiler_name @@ -1817,6 +1823,144 @@ logical function check_fortran_source_runs(self, input, compile_flags, link_flag end function check_fortran_source_runs +!> Check if the given C source code compiles, links, and runs successfully +logical function check_c_source_runs(self, input, compile_flags, link_flags) result(success) + !> Instance of the compiler object + class(compiler_t), intent(in) :: self + !> C program source + character(len=*), intent(in) :: input + !> Optional build and link flags + character(len=*), optional, intent(in) :: compile_flags, link_flags + integer :: stat,unit + character(:), allocatable :: source,object,logf,exe,flags,ldflags + + success = .false. + + !> Create temporary source file + exe = get_temp_filename() + source = exe//'.c' + object = exe//'.o' + logf = exe//'.log' + + open(newunit=unit, file=source, action='readwrite', iostat=stat) + if (stat/=0) return + + !> Write contents + write(unit,'(a)') input + close(unit) + + !> Get flags + flags = "" + ldflags = "" + if (present(compile_flags)) flags = flags//" "//compile_flags + if (present(link_flags)) ldflags = ldflags//" "//link_flags + + !> Compile + call self%compile_c(source,object,flags,logf,stat,dry_run=.false.) + if (stat/=0) return + + !> Link + call self%link(exe,ldflags//" "//object,logf,stat) + if (stat/=0) return + + !> Run + call run(exe//" > "//logf//" 2>&1",echo=.false.,exitstat=stat) + success = (stat == 0) + + !> Delete temporary files + open(newunit=unit, file=source, action='readwrite', iostat=stat) + close(unit,status='delete') + open(newunit=unit, file=object, action='readwrite', iostat=stat) + close(unit,status='delete') + open(newunit=unit, file=logf, action='readwrite', iostat=stat) + close(unit,status='delete') + open(newunit=unit, file=exe, action='readwrite', iostat=stat) + close(unit,status='delete') + +end function check_c_source_runs + +!> Check if the given C++ source code compiles, links, and runs successfully +logical function check_cxx_source_runs(self, input, compile_flags, link_flags) result(success) + !> Instance of the compiler object + class(compiler_t), intent(in) :: self + !> C++ program source + character(len=*), intent(in) :: input + !> Optional build and link flags + character(len=*), optional, intent(in) :: compile_flags, link_flags + integer :: stat,unit + character(:), allocatable :: source,object,logf,exe,flags,ldflags + + success = .false. + + !> Create temporary source file + exe = get_temp_filename() + source = exe//'.cpp' + object = exe//'.o' + logf = exe//'.log' + + open(newunit=unit, file=source, action='readwrite', iostat=stat) + if (stat/=0) return + + !> Write contents + write(unit,'(a)') input + close(unit) + + !> Get flags + flags = "" + ldflags = "" + if (present(compile_flags)) flags = flags//" "//compile_flags + if (present(link_flags)) ldflags = ldflags//" "//link_flags + + !> Compile + call self%compile_cpp(source,object,flags,logf,stat,dry_run=.false.) + if (stat/=0) return + + !> Link + call self%link(exe,ldflags//" "//object,logf,stat) + if (stat/=0) return + + !> Run + call run(exe//" > "//logf//" 2>&1",echo=.false.,exitstat=stat) + success = (stat == 0) + + !> Delete temporary files + open(newunit=unit, file=source, action='readwrite', iostat=stat) + close(unit,status='delete') + open(newunit=unit, file=object, action='readwrite', iostat=stat) + close(unit,status='delete') + open(newunit=unit, file=logf, action='readwrite', iostat=stat) + close(unit,status='delete') + open(newunit=unit, file=exe, action='readwrite', iostat=stat) + close(unit,status='delete') + +end function check_cxx_source_runs + +!> Check if the given C compile and/or link flags are accepted by the C compiler +logical function check_c_flags_supported(self, compile_flags, link_flags) + class(compiler_t), intent(in) :: self + character(len=*), optional, intent(in) :: compile_flags, link_flags + + ! Minimal C program that always compiles + character(len=*), parameter :: hello_world_c = & + "#include " // new_line('a') // & + "int main() { printf(""Hello, World!""); return 0; }" + + check_c_flags_supported = self%check_c_source_runs(hello_world_c, compile_flags, link_flags) +end function check_c_flags_supported + +!> Check if the given C++ compile and/or link flags are accepted by the C++ compiler +logical function check_cxx_flags_supported(self, compile_flags, link_flags) + class(compiler_t), intent(in) :: self + character(len=*), optional, intent(in) :: compile_flags, link_flags + + ! Minimal C++ program that always compiles + character(len=*), parameter :: hello_world_cxx = & + "#include " // new_line('a') // & + "int main() { printf(""Hello, World!""); return 0; }" + + check_cxx_flags_supported = self%check_cxx_source_runs(hello_world_cxx, compile_flags, link_flags) +end function check_cxx_flags_supported + !> Check if the given compile and/or link flags are accepted by the compiler logical function check_flags_supported(self, compile_flags, link_flags) class(compiler_t), intent(in) :: self diff --git a/src/fpm_targets.f90 b/src/fpm_targets.f90 index 07581f1433..7d23207160 100644 --- a/src/fpm_targets.f90 +++ b/src/fpm_targets.f90 @@ -1113,6 +1113,11 @@ subroutine resolve_target_linking(targets, model, library, error) ! Build link flags target%link_flags = string_cat(target%link_objects, " ") + ! Add global link flags (including metapackage flags like OpenMP) + if (allocated(model%link_flags)) then + target%link_flags = model%link_flags//" "//target%link_flags + endif + target%link_flags = target%link_flags // shared_lib_paths ! Add dependencies' shared libraries (excluding self) diff --git a/src/metapackage/fpm_meta_openmp.f90 b/src/metapackage/fpm_meta_openmp.f90 index 49dd793117..be6b56f534 100644 --- a/src/metapackage/fpm_meta_openmp.f90 +++ b/src/metapackage/fpm_meta_openmp.f90 @@ -25,57 +25,86 @@ subroutine init_openmp(this,compiler,all_meta,error) type(metapackage_request_t), intent(in) :: all_meta(:) type(error_t), allocatable, intent(out) :: error + !> Local variables for OpenMP testing + character(:), allocatable :: openmp_flag, link_flag + character(len=*), parameter :: openmp_test_fortran = & + "use omp_lib; if (omp_get_max_threads() <= 0) stop 1; end" + character(len=*), parameter :: openmp_test_c = & + "#include " // new_line('a') // & + "int main() { return omp_get_max_threads() > 0 ? 0 : 1; }" + character(len=*), parameter :: openmp_test_cxx = & + "#include " // new_line('a') // & + "int main() { return omp_get_max_threads() > 0 ? 0 : 1; }" + !> Cleanup call destroy(this) !> Set name this%name = "openmp" - !> OpenMP has compiler flags - this%has_build_flags = .true. - this%has_link_flags = .true. - - !> OpenMP flags should be added to + !> Get OpenMP flags based on compiler which_compiler: select case (compiler%id) case (id_gcc,id_f95) - this%flags = string_t(flag_gnu_openmp) - this%link_flags = string_t(flag_gnu_openmp) + openmp_flag = flag_gnu_openmp + link_flag = flag_gnu_openmp case (id_intel_classic_windows,id_intel_llvm_windows) - this%flags = string_t(flag_intel_openmp_win) - this%link_flags = string_t(flag_intel_openmp_win) + openmp_flag = flag_intel_openmp_win + link_flag = flag_intel_openmp_win case (id_intel_classic_nix,id_intel_classic_mac,& id_intel_llvm_nix) - this%flags = string_t(flag_intel_openmp) - this%link_flags = string_t(flag_intel_openmp) + openmp_flag = flag_intel_openmp + link_flag = flag_intel_openmp case (id_pgi,id_nvhpc) - this%flags = string_t(flag_pgi_openmp) - this%link_flags = string_t(flag_pgi_openmp) + openmp_flag = flag_pgi_openmp + link_flag = flag_pgi_openmp case (id_ibmxl) - this%flags = string_t(" -qsmp=omp") - this%link_flags = string_t(" -qsmp=omp") + openmp_flag = " -qsmp=omp" + link_flag = " -qsmp=omp" case (id_nag) - this%flags = string_t(flag_nag_openmp) - this%link_flags = string_t(flag_nag_openmp) + openmp_flag = flag_nag_openmp + link_flag = flag_nag_openmp case (id_lfortran) - this%flags = string_t(flag_lfortran_openmp) - this%link_flags = string_t(flag_lfortran_openmp) + openmp_flag = flag_lfortran_openmp + link_flag = flag_lfortran_openmp case (id_flang, id_flang_new) - this%flags = string_t(flag_flang_new_openmp) - this%link_flags = string_t(flag_flang_new_openmp) + openmp_flag = flag_flang_new_openmp + link_flag = flag_flang_new_openmp case default - call fatal_error(error,'openmp not supported on compiler '//compiler%name()//' yet') + return end select which_compiler + !> Test Fortran OpenMP support + if (compiler%check_fortran_source_runs(openmp_test_fortran, openmp_flag, link_flag)) then + this%has_fortran_flags = .true. + this%fflags = string_t(openmp_flag) + endif + + !> Test C OpenMP support + if (compiler%check_c_source_runs(openmp_test_c, openmp_flag, link_flag)) then + this%has_c_flags = .true. + this%cflags = string_t(openmp_flag) + endif + + !> Test C++ OpenMP support + if (compiler%check_cxx_source_runs(openmp_test_cxx, openmp_flag, link_flag)) then + this%has_cxx_flags = .true. + this%cxxflags = string_t(openmp_flag) + endif + + !> Always set link flags when OpenMP is requested + !> The linker needs OpenMP flags regardless of individual compiler support + this%has_link_flags = .true. + this%link_flags = string_t(link_flag) end subroutine init_openmp end module fpm_meta_openmp diff --git a/test/fpm_test/test_compiler.f90 b/test/fpm_test/test_compiler.f90 index 1472b86f4c..66349f070e 100644 --- a/test/fpm_test/test_compiler.f90 +++ b/test/fpm_test/test_compiler.f90 @@ -22,6 +22,8 @@ subroutine collect_compiler(testsuite) testsuite = [ & & new_unittest("check-fortran-source-runs", test_check_fortran_source_runs), & + & new_unittest("check-c-source-runs", test_check_c_source_runs), & + & new_unittest("check-cxx-source-runs", test_check_cxx_source_runs), & & new_unittest("tokenize-flags", test_tokenize_flags), & & new_unittest("compile-commands-unix", test_register_compile_command_unix), & & new_unittest("compile-commands-windows", test_register_compile_command_windows)] @@ -95,6 +97,121 @@ subroutine test_check_fortran_source_runs(error) end subroutine test_check_fortran_source_runs + subroutine test_check_c_source_runs(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(:), allocatable :: fc,cc,cxx + type(compiler_t) :: compiler + + !> Get default compiler + fc = get_fpm_env("FC", default="gfortran") + cc = get_fpm_env("CC", default=" ") + cxx = get_fpm_env("CXX", default=" ") + + call new_compiler(compiler, fc, cc, cxx, echo=.false., verbose=.false.) + + if (compiler%is_unknown()) then + call test_failed(error, "Cannot initialize compiler") + return + end if + + !> Skip tests if no C compiler is available + if (len_trim(compiler%cc) == 0) then + return + end if + + !> Test C source runs with simple hello world + if (.not.compiler%check_c_source_runs( & + '#include ' // new_line('a') // & + 'int main() { printf("Hello C world!"); return 0; }')) then + call test_failed(error, "Cannot run C hello world") + return + end if + + !> Test with invalid source that should fail + if (compiler%check_c_source_runs( & + '#include ' // new_line('a') // & + 'int main() { return 1; }')) then ! Returns error code 1 + call test_failed(error, "C program returning error code 1 did not fail") + return + end if + + !> Test with invalid flags + if (compiler%check_c_source_runs( & + '#include ' // new_line('a') // & + 'int main() { return 0; }', & + compile_flags=" -invalid-c-flag")) then + call test_failed(error, "Invalid C compile flags did not trigger an error") + return + end if + + !> Test the C flag check wrapper + if (compiler%check_c_flags_supported(compile_flags='-not-a-c-flag')) then + call test_failed(error, "Invalid C compile flags did not trigger an error") + return + end if + + end subroutine test_check_c_source_runs + + subroutine test_check_cxx_source_runs(error) + !> Error handling + type(error_t), allocatable, intent(out) :: error + + character(:), allocatable :: fc,cc,cxx + type(compiler_t) :: compiler + + !> Get default compiler + fc = get_fpm_env("FC", default="gfortran") + cc = get_fpm_env("CC", default=" ") + cxx = get_fpm_env("CXX", default=" ") + + call new_compiler(compiler, fc, cc, cxx, echo=.false., verbose=.false.) + + if (compiler%is_unknown()) then + call test_failed(error, "Cannot initialize compiler") + return + end if + + !> Skip tests if no C++ compiler is available or if it's set to a space + if (len_trim(compiler%cxx) == 0 .or. trim(compiler%cxx) == " ") then + return + end if + + !> Test C++ source runs with simple hello world + !> Only fail if we're sure the compiler is available + if (.not.compiler%check_cxx_source_runs( & + '#include ' // new_line('a') // & + 'int main() { return 0; }')) then + !> This might fail if C++ compiler is misconfigured, so just skip further tests + return + end if + + !> Test with invalid source that should fail + if (compiler%check_cxx_source_runs( & + '#include ' // new_line('a') // & + 'int main() { return 1; }')) then ! Returns error code 1 + call test_failed(error, "C++ program returning error code 1 did not fail") + return + end if + + !> Test with invalid flags + if (compiler%check_cxx_source_runs( & + '#include ' // new_line('a') // & + 'int main() { return 0; }', & + compile_flags=" -invalid-cxx-flag")) then + call test_failed(error, "Invalid C++ compile flags did not trigger an error") + return + end if + + !> Test the C++ flag check wrapper + if (compiler%check_cxx_flags_supported(compile_flags='-not-a-cxx-flag')) then + call test_failed(error, "Invalid C++ compile flags did not trigger an error") + return + end if + + end subroutine test_check_cxx_source_runs + subroutine test_tokenize_flags(error) type(error_t), allocatable, intent(out) :: error