diff --git a/include/assert_features.h b/include/assert_features.h new file mode 100644 index 0000000..c08c338 --- /dev/null +++ b/include/assert_features.h @@ -0,0 +1,14 @@ +#ifndef _ASSERT_FEATURES_H +#define _ASSERT_FEATURES_H + +! Whether or not the assert library may use multi-image features +! Default is compiler-dependent +#ifndef ASSERT_MULTI_IMAGE +# if defined(__flang__) || defined(__INTEL_COMPILER) +# define ASSERT_MULTI_IMAGE 0 +# else +# define ASSERT_MULTI_IMAGE 1 +# endif +#endif + +#endif diff --git a/src/assert/assert_subroutine_s.F90 b/src/assert/assert_subroutine_s.F90 index 58a0372..54fc15b 100644 --- a/src/assert/assert_subroutine_s.F90 +++ b/src/assert/assert_subroutine_s.F90 @@ -4,6 +4,9 @@ ! "Multi-Dimensional Physics Implementation into Fuel Analysis under Steady-state and Transients (FAST)", ! contract # NRC-HQ-60-17-C-0007 ! + +#include "assert_features.h" + submodule(assert_subroutine_m) assert_subroutine_s implicit none @@ -26,7 +29,7 @@ check_assertion: & if (.not. assertion) then -#ifndef __flang__ +#if ASSERT_MULTI_IMAGE associate(me=>this_image()) ! work around gfortran bug header = 'Assertion "' // description // '" failed on image ' // string(me) end associate diff --git a/test/run-false-assertion-intel.sh b/test/run-false-assertion-intel.sh new file mode 100755 index 0000000..91a0a63 --- /dev/null +++ b/test/run-false-assertion-intel.sh @@ -0,0 +1,3 @@ +#!/bin/bash +output=$(fpm run --example false-assertion --compiler ifx --flag '-O3 -DASSERTIONS' > /dev/null 2>&1) +echo $? diff --git a/test/test-assert-subroutine-error-termination.F90 b/test/test-assert-subroutine-error-termination.F90 index 4fb8ef1..5174df7 100644 --- a/test/test-assert-subroutine-error-termination.F90 +++ b/test/test-assert-subroutine-error-termination.F90 @@ -1,3 +1,5 @@ +#include "assert_features.h" + program test_assert_subroutine_error_termination !! Test "assert" subroutine calls that are intended to error terminate use assert_m, only : assert @@ -21,7 +23,7 @@ program test_assert_subroutine_error_termination #elif __flang__ command = "./test/run-false-assertion.sh | fpm run --example check-exit-status", & #elif __INTEL_COMPILER - command = "fpm run --example false-assertion --compiler ifx --flag '-DASSERTIONS -O3' > /dev/null 2>&1", & + command = "./test/run-false-assertion-intel.sh | fpm run --example check-exit-status", & #elif _CRAYFTN command = "fpm run --example false-assertion --profile release --compiler crayftn.sh --flag '-DASSERTIONS' > /dev/null 2>&1", & #else @@ -31,7 +33,7 @@ program test_assert_subroutine_error_termination exitstat = exit_status & ) -#ifndef __flang__ +#if ASSERT_MULTI_IMAGE block logical error_termination @@ -63,7 +65,7 @@ pure function and_operation(lhs,rhs) result(lhs_and_rhs) lhs_and_rhs = lhs .and. rhs end function -#ifndef __flang__ +#if ASSERT_MULTI_IMAGE subroutine co_all(boolean) logical, intent(inout) :: boolean call co_reduce(boolean, and_operation) diff --git a/test/test-assert-subroutine-normal-termination.F90 b/test/test-assert-subroutine-normal-termination.F90 index e5888f8..e647e19 100644 --- a/test/test-assert-subroutine-normal-termination.F90 +++ b/test/test-assert-subroutine-normal-termination.F90 @@ -1,3 +1,5 @@ +#include "assert_features.h" + program test_assert_subroutine_normal_termination !! Test direct calls to the "assert" subroutine that don't error-terminate use assert_m, only : assert @@ -12,7 +14,7 @@ program test_assert_subroutine_normal_termination call assert( .true., "1 keyword argument ", diagnostic_data=0) call assert( .true., "0 keyword arguments ", 0) call assert( .true., "no optional argument" ) -#ifndef __flang__ +#if ASSERT_MULTI_IMAGE sync all if (this_image()==1) & #endif @@ -30,7 +32,7 @@ program test_assert_subroutine_normal_termination call assert(all(integer_1D < 3 ), "all(int_array < 3 )", intrinsic_array_t(integer_1D)) call assert(all(logical_1D ), "all(logical_array )", intrinsic_array_t(logical_1D)) call assert(all(real_1D < 3.), "all(real_array < 3.)", intrinsic_array_t( real_1D)) -#ifndef __flang__ +#if ASSERT_MULTI_IMAGE sync all if (this_image()==1) & #endif