Error stop improvements

.github/workflows/CI.yml

@@ -101,7 +101,7 @@ jobs:
         fc: [ifort]
     env:
       MACOS_HPCKIT_URL: >-
-        https://registrationcenter-download.intel.com/akdlm/irc_nas/17398/m_HPCKit_p_2021.1.0.2681_offline.dmg
+        https://registrationcenter-download.intel.com/akdlm/irc_nas/17890/m_HPCKit_p_2021.3.0.3226_offline.dmg
       MACOS_FORTRAN_COMPONENTS: >-
         intel.oneapi.mac.ifort-compiler
       FC: ${{ matrix.fc }}

CMakeLists.txt

@@ -44,9 +44,13 @@ endif()
 # --- compiler feature checks
 include(CheckFortranSourceCompiles)
 include(CheckFortranSourceRuns)
-check_fortran_source_runs("i=0; error stop i; end" f18errorstop)
+check_fortran_source_runs("program test_error_stop
+integer, parameter :: i=0
+error stop i
+end program"
+f18errorstop)
 check_fortran_source_compiles("real, allocatable :: array(:, :, :, :, :, :, :, :, :, :); end" f03rank SRC_EXT f90)
-check_fortran_source_runs("use, intrinsic :: iso_fortran_env, only : real128; real(real128) :: x; x = x+1; end" f03real128)
+# check_fortran_source_runs("use, intrinsic :: iso_fortran_env, only : real128; real(real128) :: x; x = x+1; end" f03real128)
 
 if(NOT DEFINED CMAKE_MAXIMUM_RANK)
   set(CMAKE_MAXIMUM_RANK 4 CACHE STRING "Maximum array rank for generated procedures")

src/CMakeLists.txt

@@ -14,7 +14,7 @@ set(fppFiles
     stdlib_sorting.fypp
     stdlib_sorting_ord_sort.fypp
     stdlib_sorting_sort.fypp
-    stdlib_sorting_sort_index.fypp 
+    stdlib_sorting_sort_index.fypp
     stdlib_stats.fypp
     stdlib_stats_corr.fypp
     stdlib_stats_cov.fypp
@@ -69,12 +69,6 @@ target_include_directories(${PROJECT_NAME} PUBLIC
     $<INSTALL_INTERFACE:${CMAKE_INSTALL_MODULEDIR}>
 )
 
-if(f18errorstop)
-  target_sources(${PROJECT_NAME} PRIVATE f18estop.f90)
-else()
-  target_sources(${PROJECT_NAME} PRIVATE f08estop.f90)
-endif()
-
 add_subdirectory(tests)
 
 install(TARGETS ${PROJECT_NAME}

src/Makefile.manual

@@ -31,8 +31,7 @@ SRCFYPP =\
         stdlib_stats_distribution_PRNG.fypp \
         stdlib_string_type.fypp
 
-SRC = f18estop.f90 \
-      stdlib_error.f90 \
+SRC = stdlib_error.f90 \
       stdlib_specialfunctions.f90 \
       stdlib_specialfunctions_legendre.f90 \
       stdlib_io.f90 \
@@ -67,7 +66,6 @@ $(SRCGEN): %.f90: %.fypp common.fypp
 	fypp $(FYPPFLAGS) $< $@
 
 # Fortran module dependencies
-f18estop.o: stdlib_error.o
 stdlib_ascii.o: stdlib_kinds.o
 stdlib_bitsets.o: stdlib_kinds.o
 stdlib_bitsets_64.o: stdlib_bitsets.o

src/stdlib_error.f90

@@ -6,21 +6,44 @@ module stdlib_error
 implicit none
 private
 
-interface ! f{08,18}estop.f90
-    module subroutine error_stop(msg, code)
-        !! version: experimental
-        !!
-        !! Provides a call to `error stop` and allows the user to specify a code and message
-        !! ([Specification](..//page/specs/stdlib_error.html#description_1))
-        character(*), intent(in) :: msg
-        integer, intent(in), optional :: code
-    end subroutine error_stop
-end interface
-
 public :: check, error_stop
 
 contains
 
+
+subroutine error_stop(msg, code)
+    !! version: experimental
+    !!
+    !! Provides a call to `error stop` and allows the user to specify a code and message
+    !! ([Specification](..//page/specs/stdlib_error.html#description_1))
+    !!
+    !! 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.
+    !!
+    !!##### Examples
+    !!
+    !!```fortran
+    !!  call error_stop("Invalid argument")
+    !!```
+    !!```fortran
+    !!  call error_stop("Invalid argument", 123)
+    !!```
+
+    character(*), intent(in) :: msg
+    integer, intent(in), optional :: code
+
+    if(.not.present(code)) error stop msg
+
+    write(stderr, '(a)') msg
+    error stop code
+
+end subroutine error_stop
+
+
 subroutine check(condition, msg, code, warn)
     !! version: experimental
     !!

src/tests/CMakeLists.txt

@@ -1,6 +1,6 @@
 macro(ADDTEST name)
     add_executable(test_${name} test_${name}.f90)
-    target_link_libraries(test_${name} ${PROJECT_NAME})
+    target_link_libraries(test_${name} PRIVATE ${PROJECT_NAME})
     add_test(NAME ${name}
              COMMAND $<TARGET_FILE:test_${name}> ${CMAKE_CURRENT_BINARY_DIR}
              WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
@@ -19,7 +19,26 @@ add_subdirectory(system)
 add_subdirectory(quadrature)
 add_subdirectory(math)
 
-ADDTEST(always_skip)
-set_tests_properties(always_skip PROPERTIES SKIP_RETURN_CODE 77)
-ADDTEST(always_fail)
-set_tests_properties(always_fail PROPERTIES WILL_FAIL true)
+# some compilers have broken error stop return code handling
+if(f18errorstop)
+  set(DISABLE_ESTOP_TESTS false)
+else()
+  set(DISABLE_ESTOP_TESTS true)
+endif()
+
+add_executable(test_error_handling test_error_driver.f90)
+
+add_executable(test_always_77 test_always_77.f90)
+target_link_libraries(test_always_77 PRIVATE ${PROJECT_NAME})
+add_test(NAME test_error_77
+    COMMAND $<TARGET_FILE:test_error_handling> $<TARGET_FILE:test_always_77> 77)
+
+add_executable(test_always_1 test_always_fail.f90)
+target_link_libraries(test_always_1 PRIVATE ${PROJECT_NAME})
+add_test(NAME test_error_1
+    COMMAND $<TARGET_FILE:test_error_handling> $<TARGET_FILE:test_always_1> 1)
+
+set_tests_properties(test_error_77 test_error_1 PROPERTIES
+  TIMEOUT 5
+  DISABLED ${DISABLE_ESTOP_TESTS}
+)

src/tests/test_always_skip.f90 → src/tests/test_always_77.f90

@@ -1,4 +1,4 @@
-program test_always_skip
+program test_always_77
 
 use stdlib_error, only: check
 implicit none

src/tests/test_error_driver.f90

@@ -0,0 +1,28 @@
+program test_driver
+!! tests return codes from programs.
+!! useful for checking "error stop" return codes.
+!!
+!! Arguments:
+!!  prog: program to run and catch return code
+
+implicit none
+
+integer :: ierr, ok_code, cmderr
+character(1024) :: prog
+character(3) :: ok, actual
+
+call get_command_argument(1, prog, status=ierr)
+if(ierr/=0) error stop "please specify a program to catch return codes from"
+
+call get_command_argument(2, ok, status=ierr)
+if(ierr/=0) error stop "please specify the expected return code"
+
+read(ok, '(i3)') ok_code
+
+call execute_command_line(trim(prog), exitstat=ierr, cmdstat=cmderr)
+if(cmderr/=0) error stop "test_driver had problem running always-fail program"
+
+write(actual, '(i3)') ierr
+if(ierr /= ok_code) error stop "expected return code "//ok//", got "//actual//" instead"
+
+end program