accomodate f2008 compilers via submodule

Author: scivision

Diff for: CMakeLists.txt

@@ -5,4 +5,8 @@ enable_testing()
 # this avoids stdlib and projects using stdlib from having to introspect stdlib's directory structure
 set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR})
 
+# compiler feature checks
+include(CheckFortranSourceCompiles)
+check_fortran_source_compiles("error stop i; end" f18errorstop SRC_EXT f90)
+
 add_subdirectory(src)

Diff for: src/CMakeLists.txt

@@ -6,6 +6,12 @@ set(SRC
 
 add_library(fortran_stdlib ${SRC})
 
+if(f18errorstop)
+  target_sources(fortran_stdlib PRIVATE f18estop.f90)
+else()
+  target_sources(fortran_stdlib PRIVATE f08estop.f90)
+endif()
+
 add_subdirectory(tests)
 
 install(TARGETS fortran_stdlib

Diff for: src/f08estop.f90

@@ -0,0 +1,39 @@
+submodule (stdlib_experimental_error) estop
+
+contains
+
+module procedure error_stop
+! Aborts the program with nonzero exit code
+! this is a fallback for Fortran 2008 error stop (e.g. Intel 19.1/2020 compiler)
+!
+! The "stop <character>" statement generally has return code 0.
+! To allow non-zero return code termination with character message,
+! error_stop() uses the statement "error stop", which by default
+! has exit code 1 and prints the message to stderr.
+! An optional integer return code "code" may be specified.
+!
+! Example
+! -------
+!
+! call error_stop("Invalid argument")
+
+write(stderr,*) msg
+
+if(present(code)) then
+  select case (code)
+  case (1)
+    error stop 1
+  case (2)
+    error stop 2
+  case (77)
+    error stop 77
+  case default
+    write(stderr,*) 'ERROR: code ',code,' was specified.'
+    error stop
+  end select
+else
+  error stop
+endif
+end procedure
+
+end submodule estop

Diff for: src/f18estop.f90

@@ -0,0 +1,27 @@
+submodule (stdlib_experimental_error) estop
+
+contains
+
+module procedure error_stop
+! Aborts the program with nonzero exit code
+!
+! The "stop <character>" statement generally has return code 0.
+! To allow non-zero return code termination with character message,
+! error_stop() uses the statement "error stop", which by default
+! has exit code 1 and prints the message to stderr.
+! An optional integer return code "code" may be specified.
+!
+! Example
+! -------
+!
+! call error_stop("Invalid argument")
+
+if(present(code)) then
+  write(stderr,*) msg
+  error stop code
+else
+  error stop msg
+endif
+end procedure
+
+end submodule estop

Diff for: src/stdlib_experimental_error.f90

@@ -2,6 +2,14 @@ module stdlib_experimental_error
 use, intrinsic :: iso_fortran_env, only: stderr=>error_unit
 implicit none
 private
+
+interface ! f{08,18}estop.f90
+module subroutine error_stop(msg, code)
+character(*), intent(in) :: msg
+integer, intent(in), optional :: code
+end subroutine error_stop
+end interface
+
 public :: assert, error_stop
 
 contains
@@ -23,31 +31,4 @@ subroutine assert(condition, code)
 if (.not. condition) call error_stop("Assert failed.", code)
 end subroutine
 
-subroutine error_stop(msg, code)
-! Aborts the program with nonzero exit code
-!
-! The "stop <character>" statement generally has return code 0.
-! To allow non-zero return code termination with character message,
-! error_stop() uses the statement "error stop", which by default
-! has exit code 1 and prints the message to stderr.
-! An optional integer return code "code" may be specified.
-!
-! Example
-! -------
-!
-! call error_stop("Invalid argument")
-
-character(len=*) :: msg ! Message to print on stderr
-integer, intent(in), optional :: code
-
-integer :: returncode
-
-if(present(code)) then
-  write(stderr,*) msg
-  error stop code
-else
-  error stop msg
-endif
-end subroutine
-
 end module

Diff for: src/tests/loadtxt/test_loadtxt.f90

@@ -1,6 +1,7 @@
 program test_loadtxt
 use iso_fortran_env, only: sp=>real32, dp=>real64 ,qp=>real128
 use stdlib_experimental_io, only: loadtxt
+use stdlib_experimental_error, only: error_stop
 implicit none
 
 real(sp), allocatable :: s(:, :)
@@ -46,8 +47,7 @@ subroutine print_array(a)
     print *, a(i, :)
    end do
   class default
-   write(*,'(a)')'The proposed type is not supported'
-   error stop
+   call error_stop('The proposed type is not supported')
  end select
 
 end subroutine