Merge pull request #53 from scivision/returncode

error_stop to stderr and optional returncode

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)

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

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

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

src/stdlib_experimental_error.f90

@@ -1,41 +1,34 @@
 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
 
-subroutine assert(condition)
+subroutine assert(condition, code)
 ! If condition == .false., it aborts the program.
 !
 ! Arguments
 ! ---------
 !
 logical, intent(in) :: condition
+integer, intent(in), optional :: code
 !
 ! Example
 ! -------
 !
 ! call assert(a == 5)
 
-if (.not. condition) call error_stop("Assert failed.")
-end subroutine
-
-subroutine error_stop(msg)
-! Aborts the program with nonzero exit code
-!
-! The statement "stop msg" will return 0 exit code when compiled using
-! gfortran. error_stop() uses the statement "stop 1" which returns an exit code
-! 1 and a print statement to print the message.
-!
-! Example
-! -------
-!
-! call error_stop("Invalid argument")
-
-character(len=*) :: msg ! Message to print on stdout
-print *, msg
-stop 1
+if (.not. condition) call error_stop("Assert failed.", code)
 end subroutine
 
 end module

src/tests/CMakeLists.txt

@@ -1,3 +1,12 @@
 add_subdirectory(ascii)
 add_subdirectory(loadtxt)
 
+add_executable(test_skip test_skip.f90)
+target_link_libraries(test_skip fortran_stdlib)
+add_test(NAME AlwaysSkip COMMAND $<TARGET_FILE:test_skip>)
+set_tests_properties(AlwaysSkip PROPERTIES SKIP_RETURN_CODE 77)
+
+add_executable(test_fail test_fail.f90)
+target_link_libraries(test_fail fortran_stdlib)
+add_test(NAME AlwaysFail COMMAND $<TARGET_FILE:test_fail>)
+set_tests_properties(AlwaysFail PROPERTIES WILL_FAIL true)

src/tests/loadtxt/test_loadtxt.f90

@@ -1,6 +1,7 @@
 program test_loadtxt
 use iso_fortran_env, only: sp=>real32, dp=>real64
 use stdlib_experimental_io, only: loadtxt
+use stdlib_experimental_error, only: error_stop
 implicit none
 
 real(sp), allocatable :: s(:, :)
@@ -38,8 +39,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

src/tests/test_fail.f90

@@ -0,0 +1,8 @@
+program AlwaysFail
+
+use stdlib_experimental_error, only : assert
+implicit none
+
+call assert(.false.)
+
+end program

src/tests/test_skip.f90

@@ -0,0 +1,8 @@
+program AlwaysSkip
+
+use stdlib_experimental_error, only : assert
+implicit none
+
+call assert(.false., 77)
+
+end program