From beaf7be7c19f50694d36026da342a5a70e14451f Mon Sep 17 00:00:00 2001 From: "Michael Hirsch, Ph.D" Date: Mon, 30 Dec 2019 15:31:51 -0500 Subject: [PATCH 1/4] add tests for error_stop and optional returncode --- src/CMakeLists.txt | 1 + src/stdlib_experimental_error.f90 | 30 +++++++++++++++++++++--------- src/tests/CMakeLists.txt | 13 +++++++++++++ src/tests/test_fail.f90 | 8 ++++++++ src/tests/test_skip.f90 | 8 ++++++++ 5 files changed, 51 insertions(+), 9 deletions(-) create mode 100644 src/tests/test_fail.f90 create mode 100644 src/tests/test_skip.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 20dc511d5..89937e81d 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -1,4 +1,5 @@ set(SRC + lib/mod_stdlib.f90 stdlib_experimental_ascii.f90 stdlib_experimental_io.f90 stdlib_experimental_error.f90 diff --git a/src/stdlib_experimental_error.f90 b/src/stdlib_experimental_error.f90 index 1c82d6539..0777c54e4 100644 --- a/src/stdlib_experimental_error.f90 +++ b/src/stdlib_experimental_error.f90 @@ -1,41 +1,53 @@ module stdlib_experimental_error +use, intrinsic :: iso_fortran_env, only: stderr=>error_unit implicit none private 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.") +if (.not. condition) call error_stop("Assert failed.", code) end subroutine -subroutine error_stop(msg) +subroutine error_stop(msg, code) ! 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. +! 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") -character(len=*) :: msg ! Message to print on stdout -print *, msg -stop 1 +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 --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt index 7ba8c4a4f..fdf87d653 100644 --- a/src/tests/CMakeLists.txt +++ b/src/tests/CMakeLists.txt @@ -1,3 +1,16 @@ add_subdirectory(ascii) add_subdirectory(loadtxt) +add_executable(test_dummy test_dummy.f90) +target_link_libraries(test_dummy fortran_stdlib) +add_test(NAME Dummy COMMAND $) + +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) \ No newline at end of file diff --git a/src/tests/test_fail.f90 b/src/tests/test_fail.f90 new file mode 100644 index 000000000..8e194df86 --- /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 \ No newline at end of file diff --git a/src/tests/test_skip.f90 b/src/tests/test_skip.f90 new file mode 100644 index 000000000..2950aa3fd --- /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 \ No newline at end of file From 98ea49bb4c125856cbf1e2da9d97c0a9758bb285 Mon Sep 17 00:00:00 2001 From: "Michael Hirsch, Ph.D" Date: Mon, 30 Dec 2019 21:33:37 -0500 Subject: [PATCH 2/4] cmake: remove deprecated test --- src/CMakeLists.txt | 1 - src/tests/CMakeLists.txt | 4 ---- 2 files changed, 5 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 89937e81d..20dc511d5 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -1,5 +1,4 @@ set(SRC - lib/mod_stdlib.f90 stdlib_experimental_ascii.f90 stdlib_experimental_io.f90 stdlib_experimental_error.f90 diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt index fdf87d653..760fa20d2 100644 --- a/src/tests/CMakeLists.txt +++ b/src/tests/CMakeLists.txt @@ -1,10 +1,6 @@ add_subdirectory(ascii) add_subdirectory(loadtxt) -add_executable(test_dummy test_dummy.f90) -target_link_libraries(test_dummy fortran_stdlib) -add_test(NAME Dummy COMMAND $) - add_executable(test_skip test_skip.f90) target_link_libraries(test_skip fortran_stdlib) add_test(NAME AlwaysSkip COMMAND $) From 02e8caf99ecaf0ea014b128bf2a2c80fb01c71ee Mon Sep 17 00:00:00 2001 From: "Michael Hirsch, Ph.D" Date: Mon, 30 Dec 2019 21:56:12 -0500 Subject: [PATCH 3/4] accomodate f2008 compilers via submodule --- CMakeLists.txt | 4 +++ src/CMakeLists.txt | 6 +++++ src/f08estop.f90 | 39 ++++++++++++++++++++++++++++++ src/f18estop.f90 | 27 +++++++++++++++++++++ src/stdlib_experimental_error.f90 | 35 ++++++--------------------- src/tests/loadtxt/test_loadtxt.f90 | 4 +-- 6 files changed, 86 insertions(+), 29 deletions(-) create mode 100644 src/f08estop.f90 create mode 100644 src/f18estop.f90 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..c3b403971 --- /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 estop \ No newline at end of file diff --git a/src/f18estop.f90 b/src/f18estop.f90 new file mode 100644 index 000000000..f907f8627 --- /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 \ No newline at end of file diff --git a/src/stdlib_experimental_error.f90 b/src/stdlib_experimental_error.f90 index 0777c54e4..3d932d6c9 100644 --- a/src/stdlib_experimental_error.f90 +++ b/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 " 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 --git a/src/tests/loadtxt/test_loadtxt.f90 b/src/tests/loadtxt/test_loadtxt.f90 index 1d07c5e13..6a7e7b720 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 ,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 From 03643055d02a35bf1bce1dd657439195919068e9 Mon Sep 17 00:00:00 2001 From: "Michael Hirsch, Ph.D" Date: Mon, 30 Dec 2019 22:11:42 -0500 Subject: [PATCH 4/4] eof --- src/f08estop.f90 | 2 +- src/f18estop.f90 | 2 +- src/tests/CMakeLists.txt | 2 +- src/tests/test_fail.f90 | 2 +- src/tests/test_skip.f90 | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/f08estop.f90 b/src/f08estop.f90 index c3b403971..d50197866 100644 --- a/src/f08estop.f90 +++ b/src/f08estop.f90 @@ -36,4 +36,4 @@ endif end procedure -end submodule estop \ No newline at end of file +end submodule diff --git a/src/f18estop.f90 b/src/f18estop.f90 index f907f8627..ea83de79f 100644 --- a/src/f18estop.f90 +++ b/src/f18estop.f90 @@ -24,4 +24,4 @@ endif end procedure -end submodule estop \ No newline at end of file +end submodule estop diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt index 760fa20d2..f8544b24a 100644 --- a/src/tests/CMakeLists.txt +++ b/src/tests/CMakeLists.txt @@ -9,4 +9,4 @@ 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) \ No newline at end of file +set_tests_properties(AlwaysFail PROPERTIES WILL_FAIL true) diff --git a/src/tests/test_fail.f90 b/src/tests/test_fail.f90 index 8e194df86..4803157d6 100644 --- a/src/tests/test_fail.f90 +++ b/src/tests/test_fail.f90 @@ -5,4 +5,4 @@ program AlwaysFail call assert(.false.) -end program \ No newline at end of file +end program diff --git a/src/tests/test_skip.f90 b/src/tests/test_skip.f90 index 2950aa3fd..3fa6b1be3 100644 --- a/src/tests/test_skip.f90 +++ b/src/tests/test_skip.f90 @@ -5,4 +5,4 @@ program AlwaysSkip call assert(.false., 77) -end program \ No newline at end of file +end program