Check that Fortran sources run; Robust Fortran features (qp, xdp) for…

…tran-lang#1051

src/fpm_command_line.f90

@@ -52,7 +52,8 @@ module fpm_command_line
           fpm_update_settings, &
           fpm_clean_settings, &
           fpm_publish_settings, &
-          get_command_line_settings
+          get_command_line_settings, &
+          get_fpm_env
 
 type, abstract :: fpm_cmd_settings
     character(len=:), allocatable :: working_dir

src/fpm_compiler.F90

@@ -119,6 +119,10 @@ module fpm_compiler
     procedure :: serializable_is_same => compiler_is_same
     procedure :: dump_to_toml => compiler_dump
     procedure :: load_from_toml => compiler_load
+    !> Fortran feature support
+    procedure :: check_fortran_source_runs
+    procedure :: with_xdp
+    procedure :: with_qp
     !> Return compiler name
     procedure :: name => compiler_name
 
@@ -1034,6 +1038,7 @@ subroutine new_compiler(self, fc, cc, cxx, echo, verbose)
     else
       call get_default_cxx_compiler(self%fc, self%cxx)
     end if
+
 end subroutine new_compiler
 
 
@@ -1424,6 +1429,69 @@ pure function compiler_name(self) result(name)
    end select
 end function compiler_name
 
+!> Run a single-source Fortran program using the current compiler
+!> Compile a Fortran object
+logical function check_fortran_source_runs(self, input) result(success)
+    !> Instance of the compiler object
+    class(compiler_t), intent(in) :: self
+    !> Program Source 
+    character(len=*), intent(in) :: input
+
+    integer :: stat,unit
+    character(:), allocatable :: source,object,logf,exe
+
+    success = .false.
+
+    !> Create temporary source file
+    exe    = get_temp_filename()
+    source = exe//'.f90'
+    object = exe//'.o'
+    logf   = exe//'.log'
+    open(newunit=unit, file=source, action='readwrite', iostat=stat)
+    if (stat/=0) return
+
+    !> Write contents
+    write(unit,*) input
+    close(unit)  
+
+    !> Compile and link program 
+    call self%compile_fortran(source, object, self%get_default_flags(release=.false.), logf, stat)
+    if (stat==0) &
+    call self%link(exe, self%get_default_flags(release=.false.)//" "//object, logf, stat)
+
+    !> Run and retrieve exit code 
+    if (stat==0) &
+    call run(exe,echo=.false., exitstat=stat, verbose=.false., redirect=logf)
+
+    !> Successful exit on 0 exit code
+    success = stat==0
+
+    !> Delete 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_fortran_source_runs
+
+!> Check if the current compiler supports 128-bit real precision 
+logical function with_qp(self)
+    !> Instance of the compiler object
+    class(compiler_t), intent(in) :: self
+    with_qp = self%check_fortran_source_runs &
+              ('if (selected_real_kind(33) == -1) stop 1; end')
+end function with_qp
 
+!> Check if the current compiler supports 80-bit "extended" real precision 
+logical function with_xdp(self)
+    !> Instance of the compiler object
+    class(compiler_t), intent(in) :: self
+    with_xdp = self%check_fortran_source_runs &
+               ('if (any(selected_real_kind(18) == [-1, selected_real_kind(33)])) stop 1; end')
+end function with_xdp
 
 end module fpm_compiler

test/fpm_test/main.f90

@@ -3,6 +3,7 @@ program fpm_testing
     use, intrinsic :: iso_fortran_env, only : error_unit
     use testsuite, only : run_testsuite, new_testsuite, testsuite_t, select_suite, run_selected
     use test_toml, only : collect_toml
+    use test_compiler, only : collect_compiler
     use test_manifest, only : collect_manifest
     use test_filesystem, only : collect_filesystem
     use test_source_parsing, only : collect_source_parsing
@@ -23,7 +24,7 @@ program fpm_testing
     stat = 0
 
     suite = [ &
-        & new_testsuite("fpm_toml", collect_toml), &
+        & new_testsuite("fpm_toml", collect_toml), &        
         & new_testsuite("fpm_manifest", collect_manifest), &
         & new_testsuite("fpm_filesystem", collect_filesystem), &
         & new_testsuite("fpm_source_parsing", collect_source_parsing), &
@@ -33,7 +34,8 @@ program fpm_testing
         & new_testsuite("fpm_installer", collect_installer), &
         & new_testsuite("fpm_versioning", collect_versioning), &
         & new_testsuite("fpm_settings", collect_settings), &
-        & new_testsuite("fpm_os", collect_os) &
+        & new_testsuite("fpm_os", collect_os), &
+        & new_testsuite("fpm_compiler", collect_compiler) &
         & ]
 
     call get_argument(1, suite_name)

test/fpm_test/test_compiler.f90

@@ -0,0 +1,56 @@
+!> Define tests for the `fpm_compiler` module
+module test_compiler
+    use testsuite, only : new_unittest, unittest_t, error_t, test_failed, &
+        & check_string
+    use fpm_environment, only : OS_WINDOWS, OS_LINUX
+    use fpm_compiler   , only : compiler_t, new_compiler
+    use fpm_command_line, only: get_fpm_env
+    implicit none
+    private
+
+    public :: collect_compiler
+
+
+contains
+
+    !> Collect all exported unit tests
+    subroutine collect_compiler(testsuite)
+        !> Collection of tests
+        type(unittest_t), allocatable, intent(out) :: testsuite(:)
+
+        testsuite = [ &
+            & new_unittest("check-fortran-source-runs", test_check_fortran_source_runs)]
+
+    end subroutine collect_compiler
+
+    subroutine test_check_fortran_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 Fortran compiler")
+            return
+        end if
+
+        !> Test fortran-source runs
+        if (.not.compiler%check_fortran_source_runs("print *, 'Hello world!'; end")) then 
+            call test_failed(error, "Cannot run Fortran hello world")
+            return
+        end if        
+
+    end subroutine test_check_fortran_source_runs    
+
+
+end module test_compiler