ASSERT_PARALLEL_CALLBACKS broken with LFortran

[bonachea]

Demonstration using Assert 3.0.0 and LFortran 0.54.0 on x64_64 Linux:

fpm run --example false-assertion --compiler lfortran --verbose --flag '--cpp -DASSERTIONS -DASSERT_PARALLEL_CALLBACKS -DASSERT_MULTI_IMAGE'
 <INFO> BUILD_NAME: build/lfortran
 <INFO> COMPILER:  lfortran
 <INFO> C COMPILER:  cc
 <INFO> CXX COMPILER: cc
 <INFO> COMPILER OPTIONS:   --cpp -DASSERTIONS -DASSERT_PARALLEL_CALLBACKS -DASSERT_MULTI_IMAGE
 <INFO> C COMPILER OPTIONS:  
 <INFO> CXX COMPILER OPTIONS: 
 <INFO> LINKER OPTIONS:  
 <INFO> INCLUDE DIRECTORIES:  [././include]
[  0%]            false-assertion.F90
 + lfortran -c example/false-assertion.F90   --cpp -DASSERTIONS -DASSERT_PARALLEL_CALLBACKS -DASSERT_MULTI_IMAGE -I././include -J build/lfortran_4B9CC7ABAF553C05 -Ibuild/lfortran_4B9CC7ABAF553C05 -o build/lfortran_4B9CC7ABAF553C05/assert/example_false-assertion.F90.o
code generation error: Function code not generated for 'assert_this_image_interface'


Note: Please report unclear, confusing or incorrect messages as bugs at
https://github.com/lfortran/lfortran/issues.
[ 16%]            false-assertion.F90  done.

code generation error: Function code not generated for 'assert_this_image_interface'


Note: Please report unclear, confusing or incorrect messages as bugs at
https://github.com/lfortran/lfortran/issues.
<ERROR> Compilation failed for object " example_false-assertion.F90.o "
<ERROR> stopping due to failed compilation
STOP 1

[Pranavchiku]

I'm able to reproduce the error and looking into it.

[Pranavchiku]

Minimal example that produces same error: lfortran/lfortran#8207.

[Pranavchiku]

Here is the diff which can be used to unblock and make progress till issue gets fixed:

Please note, LFortran does not support coarrays yet hence removed -DASSERT_MULTI_IMAGE!

diff --git a/example/false-assertion.F90 b/example/false-assertion.F90
index f8e8e86..7aaf367 100644
--- a/example/false-assertion.F90
+++ b/example/false-assertion.F90
@@ -3,11 +3,11 @@ program false_assertion
   implicit none
 
 #if ASSERT_PARALLEL_CALLBACKS
-  assert_this_image => assert_callback_this_image
-  assert_error_stop => assert_callback_error_stop
+  ! assert_this_image => assert_callback_this_image
+  ! assert_error_stop => assert_callback_error_stop
 #endif
 
-  call assert(.false., "false-assertion: unconditionally failing test")
+  call assert(.false., "false-assertion: unconditionally failing test", assert_callback_this_image, assert_callback_error_stop)
 
 #if ASSERT_PARALLEL_CALLBACKS
 ! By default, assert uses `THIS_IMAGE()` in multi-image mode while
diff --git a/example/simple-assertions.f90 b/example/simple-assertions.f90
index 43cb6c2..af3eabb 100644
--- a/example/simple-assertions.f90
+++ b/example/simple-assertions.f90
@@ -3,7 +3,7 @@ program assertion_examples
   !! of two kinds of constraints:
   !! 1. Preconditions: requirements for correct execution at the start of a procedure and
   !! 2. Postconditions: requirements for correct execution at the end of a procedure.
-  use assert_m, only : assert
+  use assert_m, only : assert, dummy_assert_error_stop, dummy_assert_this_image
   implicit none
   
   print *, "roots: ", roots(a=1.,b=0.,c=-4.)
@@ -17,14 +17,14 @@ contains
     real, parameter :: tolerance = 1E-06
 
     associate(discriminant => b**2 - 4*a*c)
-      call assert(assertion = discriminant >= 0., description = "discriminant >= 0") ! precondition
+      call assert(discriminant >= 0., "discriminant >= 0", dummy_assert_this_image, dummy_assert_error_stop) ! precondition
       allocate(zeros(2))
       ! there's a deliberate math bug in the following line, to help demonstrate assertion failure
       zeros = -b + [sqrt(discriminant), -sqrt(discriminant)]
     end associate
 
     ! This assertion will fail (due to the defect above) when ASSERTIONS are enabled:
-    call assert(all(abs(a*zeros**2 + b*zeros + c) < tolerance), "All residuals within tolerance.") ! postcondition
+    call assert(all(abs(a*zeros**2 + b*zeros + c) < tolerance), "All residuals within tolerance.", dummy_assert_this_image, dummy_assert_error_stop) ! postcondition
   end function
 
 end program
diff --git a/include/assert_macros.h b/include/assert_macros.h
index ed6e390..f14f0b7 100644
--- a/include/assert_macros.h
+++ b/include/assert_macros.h
@@ -21,8 +21,8 @@
 #endif
 
 #if ASSERTIONS
-# define call_assert(assertion) call assert_always(assertion, "call_assert(" // CPP_STRINGIFY_SOURCE(assertion) // ")", __FILE__, __LINE__)
-# define call_assert_describe(assertion, description) call assert_always(assertion, description, __FILE__, __LINE__)
+# define call_assert(assertion) call assert_always(assertion, "call_assert(" // CPP_STRINGIFY_SOURCE(assertion) // ")", dummy_assert_this_image, dummy_assert_error_stop, __FILE__, __LINE__)
+# define call_assert_describe(assertion, description) call assert_always(assertion, description, dummy_assert_this_image, dummy_assert_error_stop, __FILE__, __LINE__)
 #else
 # define call_assert(assertion)
 # define call_assert_describe(assertion, description)
diff --git a/src/assert_m.F90 b/src/assert_m.F90
index 5c4ac36..4707620 100644
--- a/src/assert_m.F90
+++ b/src/assert_m.F90
@@ -35,11 +35,11 @@ module assert_m
   !!
   implicit none
   private
-  public :: assert, assert_always
+  public :: assert, assert_always, dummy_assert_error_stop, dummy_assert_this_image
 
 #if ASSERT_PARALLEL_CALLBACKS
-    public :: assert_this_image_interface, assert_this_image
-    public :: assert_error_stop_interface, assert_error_stop
+    public :: assert_this_image_interface!, assert_this_image
+    public :: assert_error_stop_interface!, assert_error_stop
 
     abstract interface
       pure function assert_this_image_interface() result(this_image_id)
@@ -47,7 +47,7 @@ module assert_m
         integer :: this_image_id
       end function
     end interface
-    procedure(assert_this_image_interface), pointer :: assert_this_image
+    ! procedure(assert_this_image_interface), pointer :: assert_this_image
     
     abstract interface
       pure subroutine assert_error_stop_interface(stop_code_char)
@@ -55,7 +55,7 @@ module assert_m
         character(len=*), intent(in) :: stop_code_char
       end subroutine
     end interface
-    procedure(assert_error_stop_interface), pointer :: assert_error_stop
+    ! procedure(assert_error_stop_interface), pointer :: assert_error_stop
 
 #endif
 
@@ -71,29 +71,55 @@ module assert_m
 
 contains
 
-    pure subroutine assert(assertion, description)
+    pure function dummy_assert_this_image() result(this_image_id)
+      implicit none
+      integer :: this_image_id
+      this_image_id = 0 ! default image ID when not using parallel callbacks
+    end function
+
+    pure subroutine dummy_assert_error_stop(stop_code_char)
+      implicit none
+      character(len=*), intent(in) :: stop_code_char
+      error stop "Dummy error stop: " // stop_code_char
+    end subroutine
+
+    pure subroutine assert(assertion, description, assert_this_image, assert_error_stop)
       !! 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
+      interface
+        pure function assert_this_image() result(this_image_id)
+          implicit none
+          integer :: this_image_id
+        end function
+
+        pure subroutine assert_error_stop(stop_code_char)
+          implicit none
+          character(len=*), intent(in) :: stop_code_char
+        end subroutine
+      end interface
+
         !! A brief statement of what is being asserted such as "i>0" or "positive i"
 
     toggle_assertions: &
     if (enforce_assertions) then
-        call assert_always(assertion, description)
+          call assert_always(assertion, description, assert_this_image, assert_error_stop)
     end if toggle_assertions
     
   end subroutine
 
-    pure subroutine assert_always(assertion, description, file, line)
+    pure subroutine assert_always(assertion, description, assert_this_image, assert_error_stop, file, line)
       !! Same as above but always enforces the assertion (regardless of ASSERTIONS)
       implicit none
       logical, intent(in) :: assertion
       character(len=*), intent(in) :: description
       character(len=*), intent(in), optional :: file
       integer, intent(in), optional :: line
+      procedure(assert_this_image_interface) :: assert_this_image
+      procedure(assert_error_stop_interface) :: assert_error_stop
     character(len=:), allocatable :: message
     character(len=:), allocatable :: location
     integer me
@@ -122,11 +148,11 @@ contains
 
 #if ASSERT_MULTI_IMAGE
 #  if ASSERT_PARALLEL_CALLBACKS
-        if (associated(assert_this_image)) then
+        ! if (associated(assert_this_image)) then
           me = assert_this_image()
-        else
-          me = 0
-        endif
+        ! else
+          ! me = 0
+        ! endif
 #  else
         me = this_image()
 #  endif
@@ -141,11 +167,11 @@ contains
 #endif
  
 #if ASSERT_PARALLEL_CALLBACKS
-        if (associated(assert_this_image)) then
+        ! if (associated(assert_this_image)) then
           call assert_error_stop(message)
-        else
+        ! else
           ; ! deliberate fall-thru
-        endif
+        ! endif
 #endif
 #ifdef __LFORTRAN__
         ! workaround a defect observed in LFortran 0.54:
diff --git a/test/test-assert-subroutine-normal-termination.F90 b/test/test-assert-subroutine-normal-termination.F90
index 6c51d3c..760a0ff 100644
--- a/test/test-assert-subroutine-normal-termination.F90
+++ b/test/test-assert-subroutine-normal-termination.F90
@@ -2,7 +2,7 @@
 
 program test_assert_subroutine_normal_termination
   !! Test direct calls to the "assert" subroutine that don't error-terminate
-  use assert_m, only : assert
+  use assert_m, only : assert, dummy_assert_error_stop, dummy_assert_this_image
   implicit none
 
 #if ASSERT_MULTI_IMAGE
@@ -14,9 +14,9 @@ program test_assert_subroutine_normal_termination
   sync all
 #endif
 
-  call assert(assertion = .true., description = "2 keyword arguments")
-  call assert(            .true., description = "1 keyword arguments")
-  call assert(            .true.,               "0 keyword arguments")
+  call assert(            .true.,               "2 keyword arguments", dummy_assert_this_image, dummy_assert_error_stop)
+  call assert(            .true.,               "1 keyword arguments", dummy_assert_this_image, dummy_assert_error_stop)
+  call assert(            .true.,               "0 keyword arguments", dummy_assert_this_image, dummy_assert_error_stop)
 
 #if ASSERT_MULTI_IMAGE
   sync all

[bonachea]

Hi @Pranavchiku - Thanks for looking into this.

Unfortunately the proposed "workaround" is not really a workaround at all, because it completely changes the semantics of what the code is doing. The whole point of the current design is the caller (outside the Assert library) registers a callback pointer once during initialization, which gets stored in Assert module state. Then many subsequent invocations of assert_always all transparently use the same callback registered at initialization. Forcing every invocation of assert_always to pass the callback pointer entirely defeats the design of the feature.

IIUC the original code it fully Fortran compliant, and it works with multiple Fortran compilers (gfortran, flang, Intel and Cray). Is there any hope of fixing the defect in LFortran to compile the original unmodified code?

[Pranavchiku]

Ahh okay, makes sense! We've submitted a patch to fix it, please find more details at lfortran/lfortran#8207 (comment).