Merge pull request #3 from rouson/fix-test

Fix test

Author: rouson

src/assert/assert_subroutine_m.F90

@@ -7,6 +7,8 @@
 !
 #include "assert_macros.h"
 
+#include "assert_features.h"
+
 module assert_subroutine_m
   !! summary: Utility for runtime enforcement of logical assertions.
   !! usage: error-terminate if the assertion fails:
@@ -66,25 +68,61 @@ pure subroutine assert_error_stop_interface(stop_code_char)
 #endif
   logical, parameter :: enforce_assertions=USE_ASSERTIONS
 
-  interface
 
-    pure module subroutine assert(assertion, description)
+contains
+
+    pure subroutine assert(assertion, description)
       !! If assertion is .false. and enforcement is enabled (e.g. via -DASSERTIONS=1),
       !! then error-terminate with a character stop code that contains the description argument if present
       implicit none
       logical, intent(in) :: assertion
         !! Most assertions will be expressions such as i>0
       character(len=*), intent(in) :: description
         !! A brief statement of what is being asserted such as "i>0" or "positive i"
-    end subroutine
 
-    pure module subroutine assert_always(assertion, description)
+    toggle_assertions: &
+    if (enforce_assertions) then
+        call assert_always(assertion, description)
+    end if toggle_assertions
+    
+  end subroutine
+
+    pure subroutine assert_always(assertion, description)
       !! Same as above but always enforces the assertion (regardless of ASSERTIONS)
       implicit none
       logical, intent(in) :: assertion
       character(len=*), intent(in) :: description
-    end subroutine
+    character(len=:), allocatable :: message
+    integer me
 
-  end interface
+      check_assertion: &
+      if (.not. assertion) then
+
+#if ASSERT_MULTI_IMAGE
+#  if ASSERT_PARALLEL_CALLBACKS
+        me = assert_this_image()
+#  else
+        me = this_image()
+#  endif
+   block
+        character(len=128) image_number
+        write(image_number, *) me
+        message = 'Assertion failure on image ' // trim(adjustl(image_number)) // ':' // description 
+   end block
+#else
+        message = 'Assertion failure: ' // description
+        me = 0 ! avoid a harmless warning
+#endif
+ 
+#if ASSERT_PARALLEL_CALLBACKS
+        call assert_error_stop(message)
+#else
+        error stop message, QUIET=.false.
+#endif
+
+      end if check_assertion
+
+  end subroutine
 
 end module assert_subroutine_m
+

src/assert/assert_subroutine_s.F90

@@ -27,7 +27,8 @@ program test_assert_subroutine_error_termination
 #elif _CRAYFTN
     command = "fpm run --example false-assertion --profile release --compiler crayftn.sh --flag '-DASSERTIONS' > /dev/null 2>&1", &
 #else
-    command = "echo 'example/false_assertion.F90: unsupported compiler' && exit 1", &
+    ! For all other compilers, we assume that the default fpm command works
+    command = "fpm run --example false-assertion --profile release --flag '-DASSERTIONS -ffree-line-length-0' > /dev/null 2>&1", &
 #endif
     wait = .true., &
     exitstat = exit_status &
@@ -47,15 +48,18 @@ program test_assert_subroutine_error_termination
       end if
     end if
   end block
+#else
+#ifdef __LFORTRAN__
+    print *,trim(merge("passes","FAILS ",exit_status/=0)) // " on error-terminating when assertion = .false."
 #else
     block
       integer unit
       open(newunit=unit, file="build/exit_status", status="old")
       read(unit,*) exit_status
-      print *,trim(merge("passes","FAILS ",exit_status/=0)) // " on error-terminating when assertion = .false."
       close(unit)
     end block 
 #endif
+#endif
 
 contains