Skip to content

Commit 0c58e66

Browse files
committed
Cleanup test-assert-subroutine-error-termination
* Fix defects introduced while adding LFortran support that broke several other configurations. * Disentangle file-passing of exit status from multi-image, so that it's properly compiler-specific * Use co_max in place of co_reduce for multi-image (cherry picked from commit f1d96ff)
1 parent c736489 commit 0c58e66

File tree

1 file changed

+18
-35
lines changed

1 file changed

+18
-35
lines changed

test/test-assert-subroutine-error-termination.F90

Lines changed: 18 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -29,58 +29,41 @@ program test_assert_subroutine_error_termination
2929
command = "fpm run --example false-assertion --compiler nagfor --flag '-DASSERTIONS -fpp' > /dev/null 2>&1", &
3030
#elif __flang__
3131
command = "./test/run-false-assertion.sh", &
32+
# define RESULT_FROM_FILE 1
3233
#elif __INTEL_COMPILER
3334
command = "./test/run-false-assertion-intel.sh", &
35+
# define RESULT_FROM_FILE 1
3436
#elif _CRAYFTN
3537
command = "fpm run --example false-assertion --profile release --compiler crayftn.sh --flag '-DASSERTIONS' > /dev/null 2>&1", &
36-
#else
37-
! For all other compilers, we assume that the default fpm command works
38+
#elif __LFORTRAN__
3839
command = "fpm run --example false-assertion --profile release --flag '-DASSERTIONS -ffree-line-length-0' > /dev/null 2>&1", &
40+
#else
41+
! All other compilers need their command manually validated and added to the list above
42+
command = "echo 'example/false_assertion.F90: unsupported compiler' && exit 1", &
3943
#endif
4044
wait = .true., &
4145
exitstat = exit_status &
4246
)
43-
44-
#if ASSERT_MULTI_IMAGE
45-
block
46-
logical error_termination
4747

48-
error_termination = exit_status /=0
49-
call co_all(error_termination)
50-
if (this_image()==1) then
51-
if (error_termination) then
52-
print *," passes on error-terminating when assertion = .false."
53-
else
54-
print *," FAILS to error-terminate when assertion = .false. (Yikes! Who designed this OS?)"
55-
end if
56-
end if
57-
end block
58-
#else
59-
#ifdef __LFORTRAN__
60-
print *,trim(merge("passes","FAILS ",exit_status/=0)) // " on error-terminating when assertion = .false."
61-
#else
62-
block
48+
#if RESULT_FROM_FILE
49+
! some compilers don't provide a reliable exitstat for the command above,
50+
! so for those we write it to a file and retrieve it here
51+
block
6352
integer unit
6453
open(newunit=unit, file="build/exit_status", status="old")
6554
read(unit,*) exit_status
6655
close(unit)
67-
end block
56+
end block
6857
#endif
69-
#endif
70-
71-
contains
72-
73-
pure function and_operation(lhs,rhs) result(lhs_and_rhs)
74-
logical, intent(in) :: lhs, rhs
75-
logical lhs_and_rhs
76-
lhs_and_rhs = lhs .and. rhs
77-
end function
7858

7959
#if ASSERT_MULTI_IMAGE
80-
subroutine co_all(boolean)
81-
logical, intent(inout) :: boolean
82-
call co_reduce(boolean, and_operation)
83-
end subroutine
60+
exit_status = abs(exit_status)
61+
call co_max(exit_status)
62+
if (this_image()==1) then
63+
print *,trim(merge("passes","FAILS ",exit_status/=0)) // " on error-terminating when assertion = .false."
64+
end if
65+
#else
66+
print *,trim(merge("passes","FAILS ",exit_status/=0)) // " on error-terminating when assertion = .false."
8467
#endif
8568

8669
end program test_assert_subroutine_error_termination

0 commit comments

Comments
 (0)