Skip to content

Commit 41a6688

Browse files
perazzperazz
authored
fix: C/C++ introspection for OpenMP flags (#1161)
2 parents b9d11e6 + c0b39cf commit 41a6688

File tree

4 files changed

+319
-22
lines changed

4 files changed

+319
-22
lines changed

‎src/fpm_compiler.F90

Lines changed: 146 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -139,6 +139,12 @@ module fpm_compiler
139139
procedure :: check_flags_supported
140140
procedure :: with_xdp
141141
procedure :: with_qp
142+
!> C feature support
143+
procedure :: check_c_source_runs
144+
procedure :: check_c_flags_supported
145+
!> C++ feature support
146+
procedure :: check_cxx_source_runs
147+
procedure :: check_cxx_flags_supported
142148
!> Return compiler name
143149
procedure :: name => compiler_name
144150

@@ -1817,6 +1823,146 @@ logical function check_fortran_source_runs(self, input, compile_flags, link_flag
18171823

18181824
end function check_fortran_source_runs
18191825

1826+
!> Check if the given C source code compiles, links, and runs successfully
1827+
logical function check_c_source_runs(self, input, compile_flags, link_flags) result(success)
1828+
!> Instance of the compiler object
1829+
class(compiler_t), intent(in) :: self
1830+
!> C program source
1831+
character(len=*), intent(in) :: input
1832+
!> Optional build and link flags
1833+
character(len=*), optional, intent(in) :: compile_flags, link_flags
1834+
integer :: stat,unit
1835+
character(:), allocatable :: source,object,logf,exe,flags,ldflags
1836+
1837+
success = .false.
1838+
1839+
!> Create temporary source file
1840+
exe = get_temp_filename()
1841+
source = exe//'.c'
1842+
object = exe//'.o'
1843+
logf = exe//'.log'
1844+
1845+
open(newunit=unit, file=source, action='readwrite', iostat=stat)
1846+
if (stat/=0) return
1847+
1848+
!> Write contents
1849+
write(unit,'(a)') input
1850+
close(unit)
1851+
1852+
!> Get flags
1853+
flags = ""
1854+
ldflags = ""
1855+
if (present(compile_flags)) flags = flags//" "//compile_flags
1856+
if (present(link_flags)) ldflags = ldflags//" "//link_flags
1857+
1858+
!> Compile
1859+
call self%compile_c(source,object,flags,logf,stat,dry_run=.false.)
1860+
if (stat/=0) return
1861+
1862+
!> Link using C compiler for pure C programs
1863+
call run(self%cc//" "//ldflags//" "//object//" -o "//exe, &
1864+
echo=self%echo, verbose=self%verbose, redirect=logf, exitstat=stat)
1865+
if (stat/=0) return
1866+
1867+
!> Run
1868+
call run(exe//" > "//logf//" 2>&1",echo=.false.,exitstat=stat)
1869+
success = (stat == 0)
1870+
1871+
!> Delete temporary files
1872+
open(newunit=unit, file=source, action='readwrite', iostat=stat)
1873+
close(unit,status='delete')
1874+
open(newunit=unit, file=object, action='readwrite', iostat=stat)
1875+
close(unit,status='delete')
1876+
open(newunit=unit, file=logf, action='readwrite', iostat=stat)
1877+
close(unit,status='delete')
1878+
open(newunit=unit, file=exe, action='readwrite', iostat=stat)
1879+
close(unit,status='delete')
1880+
1881+
end function check_c_source_runs
1882+
1883+
!> Check if the given C++ source code compiles, links, and runs successfully
1884+
logical function check_cxx_source_runs(self, input, compile_flags, link_flags) result(success)
1885+
!> Instance of the compiler object
1886+
class(compiler_t), intent(in) :: self
1887+
!> C++ program source
1888+
character(len=*), intent(in) :: input
1889+
!> Optional build and link flags
1890+
character(len=*), optional, intent(in) :: compile_flags, link_flags
1891+
integer :: stat,unit
1892+
character(:), allocatable :: source,object,logf,exe,flags,ldflags
1893+
1894+
success = .false.
1895+
1896+
!> Create temporary source file
1897+
exe = get_temp_filename()
1898+
source = exe//'.cpp'
1899+
object = exe//'.o'
1900+
logf = exe//'.log'
1901+
1902+
open(newunit=unit, file=source, action='readwrite', iostat=stat)
1903+
if (stat/=0) return
1904+
1905+
!> Write contents
1906+
write(unit,'(a)') input
1907+
close(unit)
1908+
1909+
!> Get flags
1910+
flags = ""
1911+
ldflags = ""
1912+
if (present(compile_flags)) flags = flags//" "//compile_flags
1913+
if (present(link_flags)) ldflags = ldflags//" "//link_flags
1914+
1915+
!> Compile
1916+
call self%compile_cpp(source,object,flags,logf,stat,dry_run=.false.)
1917+
if (stat/=0) return
1918+
1919+
!> Link using C++ compiler for pure C++ programs
1920+
call run(self%cxx//" "//ldflags//" "//object//" -o "//exe, &
1921+
echo=self%echo, verbose=self%verbose, redirect=logf, exitstat=stat)
1922+
if (stat/=0) return
1923+
1924+
!> Run
1925+
call run(exe//" > "//logf//" 2>&1",echo=.false.,exitstat=stat)
1926+
success = (stat == 0)
1927+
1928+
!> Delete temporary files
1929+
open(newunit=unit, file=source, action='readwrite', iostat=stat)
1930+
close(unit,status='delete')
1931+
open(newunit=unit, file=object, action='readwrite', iostat=stat)
1932+
close(unit,status='delete')
1933+
open(newunit=unit, file=logf, action='readwrite', iostat=stat)
1934+
close(unit,status='delete')
1935+
open(newunit=unit, file=exe, action='readwrite', iostat=stat)
1936+
close(unit,status='delete')
1937+
1938+
end function check_cxx_source_runs
1939+
1940+
!> Check if the given C compile and/or link flags are accepted by the C compiler
1941+
logical function check_c_flags_supported(self, compile_flags, link_flags)
1942+
class(compiler_t), intent(in) :: self
1943+
character(len=*), optional, intent(in) :: compile_flags, link_flags
1944+
1945+
! Minimal C program that always compiles
1946+
character(len=*), parameter :: hello_world_c = &
1947+
"#include <stdio.h>" // new_line('a') // &
1948+
"int main() { printf(""Hello, World!""); return 0; }"
1949+
1950+
check_c_flags_supported = self%check_c_source_runs(hello_world_c, compile_flags, link_flags)
1951+
end function check_c_flags_supported
1952+
1953+
!> Check if the given C++ compile and/or link flags are accepted by the C++ compiler
1954+
logical function check_cxx_flags_supported(self, compile_flags, link_flags)
1955+
class(compiler_t), intent(in) :: self
1956+
character(len=*), optional, intent(in) :: compile_flags, link_flags
1957+
1958+
! Minimal C++ program that always compiles
1959+
character(len=*), parameter :: hello_world_cxx = &
1960+
"#include <cstdio>" // new_line('a') // &
1961+
"int main() { printf(""Hello, World!""); return 0; }"
1962+
1963+
check_cxx_flags_supported = self%check_cxx_source_runs(hello_world_cxx, compile_flags, link_flags)
1964+
end function check_cxx_flags_supported
1965+
18201966
!> Check if the given compile and/or link flags are accepted by the compiler
18211967
logical function check_flags_supported(self, compile_flags, link_flags)
18221968
class(compiler_t), intent(in) :: self

‎src/fpm_targets.f90

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1113,6 +1113,11 @@ subroutine resolve_target_linking(targets, model, library, error)
11131113
! Build link flags
11141114
target%link_flags = string_cat(target%link_objects, " ")
11151115

1116+
! Add global link flags (including metapackage flags like OpenMP)
1117+
if (allocated(model%link_flags)) then
1118+
target%link_flags = model%link_flags//" "//target%link_flags
1119+
endif
1120+
11161121
target%link_flags = target%link_flags // shared_lib_paths
11171122

11181123
! Add dependencies' shared libraries (excluding self)

‎src/metapackage/fpm_meta_openmp.f90

Lines changed: 51 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -25,57 +25,86 @@ subroutine init_openmp(this,compiler,all_meta,error)
2525
type(metapackage_request_t), intent(in) :: all_meta(:)
2626
type(error_t), allocatable, intent(out) :: error
2727

28+
!> Local variables for OpenMP testing
29+
character(:), allocatable :: openmp_flag, link_flag
30+
character(len=*), parameter :: openmp_test_fortran = &
31+
"use omp_lib; if (omp_get_max_threads() <= 0) stop 1; end"
32+
character(len=*), parameter :: openmp_test_c = &
33+
"#include <omp.h>" // new_line('a') // &
34+
"int main() { return omp_get_max_threads() > 0 ? 0 : 1; }"
35+
character(len=*), parameter :: openmp_test_cxx = &
36+
"#include <omp.h>" // new_line('a') // &
37+
"int main() { return omp_get_max_threads() > 0 ? 0 : 1; }"
38+
2839
!> Cleanup
2940
call destroy(this)
3041

3142
!> Set name
3243
this%name = "openmp"
3344

34-
!> OpenMP has compiler flags
35-
this%has_build_flags = .true.
36-
this%has_link_flags = .true.
37-
38-
!> OpenMP flags should be added to
45+
!> Get OpenMP flags based on compiler
3946
which_compiler: select case (compiler%id)
4047
case (id_gcc,id_f95)
41-
this%flags = string_t(flag_gnu_openmp)
42-
this%link_flags = string_t(flag_gnu_openmp)
48+
openmp_flag = flag_gnu_openmp
49+
link_flag = flag_gnu_openmp
4350

4451
case (id_intel_classic_windows,id_intel_llvm_windows)
45-
this%flags = string_t(flag_intel_openmp_win)
46-
this%link_flags = string_t(flag_intel_openmp_win)
52+
openmp_flag = flag_intel_openmp_win
53+
link_flag = flag_intel_openmp_win
4754

4855
case (id_intel_classic_nix,id_intel_classic_mac,&
4956
id_intel_llvm_nix)
50-
this%flags = string_t(flag_intel_openmp)
51-
this%link_flags = string_t(flag_intel_openmp)
57+
openmp_flag = flag_intel_openmp
58+
link_flag = flag_intel_openmp
5259

5360
case (id_pgi,id_nvhpc)
54-
this%flags = string_t(flag_pgi_openmp)
55-
this%link_flags = string_t(flag_pgi_openmp)
61+
openmp_flag = flag_pgi_openmp
62+
link_flag = flag_pgi_openmp
5663

5764
case (id_ibmxl)
58-
this%flags = string_t(" -qsmp=omp")
59-
this%link_flags = string_t(" -qsmp=omp")
65+
openmp_flag = " -qsmp=omp"
66+
link_flag = " -qsmp=omp"
6067

6168
case (id_nag)
62-
this%flags = string_t(flag_nag_openmp)
63-
this%link_flags = string_t(flag_nag_openmp)
69+
openmp_flag = flag_nag_openmp
70+
link_flag = flag_nag_openmp
6471

6572
case (id_lfortran)
66-
this%flags = string_t(flag_lfortran_openmp)
67-
this%link_flags = string_t(flag_lfortran_openmp)
73+
openmp_flag = flag_lfortran_openmp
74+
link_flag = flag_lfortran_openmp
6875

6976
case (id_flang, id_flang_new)
70-
this%flags = string_t(flag_flang_new_openmp)
71-
this%link_flags = string_t(flag_flang_new_openmp)
77+
openmp_flag = flag_flang_new_openmp
78+
link_flag = flag_flang_new_openmp
7279

7380
case default
74-
7581
call fatal_error(error,'openmp not supported on compiler '//compiler%name()//' yet')
82+
return
7683

7784
end select which_compiler
7885

86+
!> Test Fortran OpenMP support
87+
if (compiler%check_fortran_source_runs(openmp_test_fortran, openmp_flag, link_flag)) then
88+
this%has_fortran_flags = .true.
89+
this%fflags = string_t(openmp_flag)
90+
endif
91+
92+
!> Test C OpenMP support
93+
if (compiler%check_c_source_runs(openmp_test_c, openmp_flag, link_flag)) then
94+
this%has_c_flags = .true.
95+
this%cflags = string_t(openmp_flag)
96+
endif
97+
98+
!> Test C++ OpenMP support
99+
if (compiler%check_cxx_source_runs(openmp_test_cxx, openmp_flag, link_flag)) then
100+
this%has_cxx_flags = .true.
101+
this%cxxflags = string_t(openmp_flag)
102+
endif
103+
104+
!> Always set link flags when OpenMP is requested
105+
!> The linker needs OpenMP flags regardless of individual compiler support
106+
this%has_link_flags = .true.
107+
this%link_flags = string_t(link_flag)
79108

80109
end subroutine init_openmp
81110
end module fpm_meta_openmp

0 commit comments

Comments
 (0)