diff --git a/CMakeLists.txt b/CMakeLists.txt index 2296751ec..ea26fc41a 100644 --- a/CMakeLists.txt +++ b/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 --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 20dc511d5..a753240ec 100644 --- a/src/CMakeLists.txt +++ b/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 --git a/src/f08estop.f90 b/src/f08estop.f90 new file mode 100644 index 000000000..d50197866 --- /dev/null +++ b/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 " 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 diff --git a/src/f18estop.f90 b/src/f18estop.f90 new file mode 100644 index 000000000..ea83de79f --- /dev/null +++ b/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 " 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 --git a/src/stdlib_experimental_error.f90 b/src/stdlib_experimental_error.f90 index 1c82d6539..3d932d6c9 100644 --- a/src/stdlib_experimental_error.f90 +++ b/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 diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt index 7ba8c4a4f..f8544b24a 100644 --- a/src/tests/CMakeLists.txt +++ b/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 $) +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 $) +set_tests_properties(AlwaysFail PROPERTIES WILL_FAIL true) diff --git a/src/tests/loadtxt/test_loadtxt.f90 b/src/tests/loadtxt/test_loadtxt.f90 index 8c8333425..4b0ba95c8 100644 --- a/src/tests/loadtxt/test_loadtxt.f90 +++ b/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 diff --git a/src/tests/test_fail.f90 b/src/tests/test_fail.f90 new file mode 100644 index 000000000..4803157d6 --- /dev/null +++ b/src/tests/test_fail.f90 @@ -0,0 +1,8 @@ +program AlwaysFail + +use stdlib_experimental_error, only : assert +implicit none + +call assert(.false.) + +end program diff --git a/src/tests/test_skip.f90 b/src/tests/test_skip.f90 new file mode 100644 index 000000000..3fa6b1be3 --- /dev/null +++ b/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