@@ -29,58 +29,41 @@ program test_assert_subroutine_error_termination
29
29
command = " fpm run --example false-assertion --compiler nagfor --flag '-DASSERTIONS -fpp' > /dev/null 2>&1" , &
30
30
#elif __flang__
31
31
command = " ./test/run-false-assertion.sh" , &
32
+ # define RESULT_FROM_FILE 1
32
33
#elif __INTEL_COMPILER
33
34
command = " ./test/run-false-assertion-intel.sh" , &
35
+ # define RESULT_FROM_FILE 1
34
36
#elif _CRAYFTN
35
37
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__
38
39
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" , &
39
43
#endif
40
44
wait = .true. , &
41
45
exitstat = exit_status &
42
46
)
43
-
44
- #if ASSERT_MULTI_IMAGE
45
- block
46
- logical error_termination
47
47
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
63
52
integer unit
64
53
open (newunit= unit, file= " build/exit_status" , status= " old" )
65
54
read (unit,* ) exit_status
66
55
close (unit)
67
- end block
56
+ end block
68
57
#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
78
58
79
59
#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."
84
67
#endif
85
68
86
69
end program test_assert_subroutine_error_termination
0 commit comments