Use external assert library

install.sh

@@ -19,6 +19,7 @@ All unrecognized arguments will be passed to GASNet's configure.
 
 Some influential environment variables:
   FC          Fortran compiler command
+  FFLAGS      Fortran compiler flags
   CC          C compiler command
   CFLAGS      C compiler flags
   CPP         C preprocessor
@@ -398,13 +399,24 @@ EOF
 
 exit_if_pkg_config_pc_file_missing "caffeine"
 
+user_compiler_flags="${CPPFLAGS:-} ${FFLAGS:-}"
+
 compiler_version=$($FPM_FC --version)
 if [[ $compiler_version == *llvm* ]]; then
   compiler_flag="-mmlir -allow-assumed-rank -g -Ofast"
 else
-  compiler_flag="-g -O3"
+  compiler_flag="-g -O3 -ffree-line-length-0"
+fi
+compiler_flag+=" -DASSERT_MULTI_IMAGE -DASSERT_PARALLEL_CALLBACKS"
+
+if ! [[ "$user_compiler_flags " =~ -[DU]ASSERTIONS[=\ ] ]] ; then 
+  # default to enabling assertions, unless the command line sets a relevant flag
+  compiler_flag+=" -DASSERTIONS"
 fi
 
+# Should come last to allow command-line overrides
+compiler_flag+=" $user_compiler_flags"
+
 RUN_FPM_SH="build/run-fpm.sh"
 cat << EOF > $RUN_FPM_SH
 #!/bin/sh

manifest/fpm.toml.template

@@ -6,6 +6,7 @@ maintainer = "rouson@lbl.gov"
 copyright = "2021-2025 The Regents of the University of California, through Lawrence Berkeley National Laboratory"
 
 [dev-dependencies]
+assert = {git = "https://github.com/berkeleylab/assert.git", tag = "2.0.1"}
 veggies = {git = "https://gitlab.com/everythingfunctional/veggies", tag = "v1.1.3"}
 iso_varying_string = {git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v3.0.4"}
 

src/caffeine/caffeine.c

@@ -99,6 +99,14 @@ void caf_decaffeinate(int exit_code)
   gasnet_exit(exit_code);
 }
 
+void caf_fatal_error( const CFI_cdesc_t* Fstr )
+{
+  const char *msg = (char *)Fstr->base_addr;
+  int len = Fstr->elem_len;
+  //printf("%p:%i\n",msg,len); fflush(0);
+  gasnett_fatalerror_nopos("%.*s", len, msg);
+}
+
 void* caf_allocate(mspace heap, size_t bytes)
 {
    void* allocated_space = mspace_memalign(heap, 8, bytes);

src/caffeine/collective_subroutines/co_max_s.f90 → src/caffeine/collective_subroutines/co_max_s.F90

@@ -1,5 +1,8 @@
 ! Copyright (c), The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
+
+#include "assert_macros.h"
+
 submodule(prif:prif_private_s) co_max_s
   use iso_c_binding, only : c_funloc
 
@@ -24,7 +27,7 @@
     function reverse_alphabetize(lhs, rhs) result(last_alphabetically)
       character(len=*), intent(in) :: lhs, rhs
       character(len=len(lhs)) :: last_alphabetically
-      call assert(len(lhs)==len(rhs), "caf_co_max: LHS/RHS length match", lhs//" , "//rhs)
+      call_assert_diagnose(len(lhs)==len(rhs), "caf_co_max: LHS/RHS length match", lhs//" , "//rhs)
       last_alphabetically = max(lhs,rhs)
     end function
 

src/caffeine/collective_subroutines/co_min_s.f90 → src/caffeine/collective_subroutines/co_min_s.F90

@@ -1,5 +1,8 @@
 ! Copyright (c), The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
+
+#include "assert_macros.h"
+
 submodule(prif:prif_private_s) co_min_s
   use iso_c_binding, only : c_funloc
 
@@ -24,7 +27,7 @@
     function alphabetize(lhs, rhs) result(first_alphabetically)
       character(len=*), intent(in) :: lhs, rhs
       character(len=len(lhs)) :: first_alphabetically
-      call assert(len(lhs)==len(rhs), "prif_co_min: LHS/RHS length match", lhs//" , "//rhs)
+      call_assert_diagnose(len(lhs)==len(rhs), "prif_co_min: LHS/RHS length match", lhs//" , "//rhs)
       first_alphabetically = min(lhs,rhs)
     end function
 

src/caffeine/collective_subroutines/co_reduce_s.f90 → src/caffeine/collective_subroutines/co_reduce_s.F90

@@ -1,5 +1,8 @@
 ! Copyright (c), The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
+
+#include "assert_macros.h"
+
 submodule(prif:prif_private_s) co_reduce_s
   use iso_c_binding, only : &
     c_loc, c_funloc, c_associated, c_f_pointer, c_f_procpointer, c_char, c_double, &
@@ -83,7 +86,7 @@ pure function c_double_complex_operation(lhs, rhs) result(lhs_op_rhs)
     procedure(c_double_complex_operation), pointer :: double_complex_op => null()
 
     if (present(stat)) stat=0
-    call assert(c_associated(operation), "caf_co_reduce: c_associated(operation)")
+    call_assert_describe(c_associated(operation), "caf_co_reduce: c_associated(operation)")
 
     if (caf_same_cfi_type(a, 0)) then
       call c_f_procpointer(operation, int32_op)
@@ -135,7 +138,7 @@ subroutine Coll_ReduceSub_c_int32_t(arg1, arg2_and_out, count, cdata) bind(C)
       integer(c_int32_t), pointer :: lhs(:)=>null(), rhs_and_result(:)=>null()
       integer(c_size_t) i
 
-      call assert(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_int32_t: operands associated")
+      call_assert_describe(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_int32_t: operands associated")
 
       call c_f_pointer(arg1, lhs, [count])
       call c_f_pointer(arg2_and_out, rhs_and_result, [count])
@@ -153,7 +156,7 @@ subroutine Coll_ReduceSub_c_int64_t(arg1, arg2_and_out, count, cdata) bind(C)
       integer(c_int64_t), pointer :: lhs(:)=>null(), rhs_and_result(:)=>null()
       integer(c_size_t) i
 
-      call assert(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_int64_t: operands associated")
+      call_assert_describe(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_int64_t: operands associated")
 
       call c_f_pointer(arg1, lhs, [count])
       call c_f_pointer(arg2_and_out, rhs_and_result, [count])
@@ -171,7 +174,7 @@ subroutine Coll_ReduceSub_c_double(arg1, arg2_and_out, count, cdata) bind(C)
       real(c_double), pointer :: lhs(:)=>null(), rhs_and_result(:)=>null()
       integer(c_size_t) i
 
-      call assert(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_double: operands associated")
+      call_assert_describe(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_double: operands associated")
 
       call c_f_pointer(arg1, lhs, [count])
       call c_f_pointer(arg2_and_out, rhs_and_result, [count])
@@ -189,7 +192,7 @@ subroutine Coll_ReduceSub_c_float(arg1, arg2_and_out, count, cdata) bind(C)
       real(c_float), pointer :: lhs(:)=>null(), rhs_and_result(:)=>null()
       integer(c_size_t) i
 
-      call assert(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_float: operands associated")
+      call_assert_describe(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_float: operands associated")
 
       call c_f_pointer(arg1, lhs, [count])
       call c_f_pointer(arg2_and_out, rhs_and_result, [count])
@@ -207,7 +210,7 @@ subroutine Coll_ReduceSub_c_double_complex(arg1, arg2_and_out, count, cdata) bin
       complex(c_double), pointer :: lhs(:)=>null(), rhs_and_result(:)=>null()
       integer(c_size_t) i
 
-      call assert(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_dobule_complex: operands associated")
+      call_assert_describe(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_dobule_complex: operands associated")
 
       call c_f_pointer(arg1, lhs, [count])
       call c_f_pointer(arg2_and_out, rhs_and_result, [count])
@@ -225,7 +228,7 @@ subroutine Coll_ReduceSub_c_float_complex(arg1, arg2_and_out, count, cdata) bind
       complex(c_float), pointer :: lhs(:)=>null(), rhs_and_result(:)=>null()
       integer(c_size_t) i
 
-      call assert(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_float_complex: operands associated")
+      call_assert_describe(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_float_complex: operands associated")
 
       call c_f_pointer(arg1, lhs, [count])
       call c_f_pointer(arg2_and_out, rhs_and_result, [count])
@@ -243,7 +246,7 @@ subroutine Coll_ReduceSub_c_bool(arg1, arg2_and_out, count, cdata) bind(C)
       logical(c_bool), pointer :: lhs(:)=>null(), rhs_and_result(:)=>null()
       integer(c_size_t) i
 
-      call assert(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_bool: operands associated")
+      call_assert_describe(all([c_associated(arg1), c_associated(arg2_and_out)]), "Coll_ReduceSub_c_bool: operands associated")
 
       call c_f_pointer(arg1, lhs, [count])
       call c_f_pointer(arg2_and_out, rhs_and_result, [count])
@@ -262,7 +265,7 @@ subroutine Coll_ReduceSub_c_char(arg1, arg2_and_out, count, cdata) bind(C)
       integer(c_int), pointer :: arglen=>null()
 
       associate(c_associated_args => [c_associated(arg1), c_associated(arg2_and_out), c_associated(cdata)])
-        call assert(all(c_associated_args), "Coll_ReduceSub_c_char: all(c_associated_args)")
+        call_assert_describe(all(c_associated_args), "Coll_ReduceSub_c_char: all(c_associated_args)")
       end associate
 
       call c_f_pointer(cdata, arglen)

src/caffeine/prif_private_s.f90

@@ -1,6 +1,7 @@
 ! Copyright (c), The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
 submodule(prif) prif_private_s
+  use assert_m
   implicit none
 
   type(team_data), target :: initial_team
@@ -9,13 +10,6 @@
 
   interface
 
-    module subroutine assert(assertion, description, diagnostics)
-      implicit none
-      logical, intent(in) :: assertion
-      character(len=*), intent(in) :: description
-      class(*), intent(in), optional :: diagnostics
-    end subroutine
-
     ! ________ Program initiation and finalization ___________
 
     subroutine caf_caffeinate( &
@@ -40,6 +34,12 @@ subroutine caf_decaffeinate(exit_code) bind(C)
       integer(c_int), value :: exit_code
     end subroutine
 
+    pure subroutine caf_fatal_error(str) bind(C)
+      !! void caf_fatal_error( const CFI_cdesc_t* Fstr )
+      use iso_c_binding, only : c_char
+      implicit none
+      character(kind=c_char,len=:), pointer, intent(in) :: str
+    end subroutine
     ! _________________ Image enumeration ____________________
 
     function caf_this_image(gex_team) bind(C)

src/caffeine/program_startup_s.F90

@@ -16,6 +16,7 @@
           initial_team%heap_size, &
           non_symmetric_heap_mspace, &
           initial_team%gex_team)
+       call assert_init()
        current_team%info => initial_team
        initial_team%parent_team => initial_team
        initial_team%team_number = -1
@@ -26,4 +27,30 @@
     end if
   end procedure
 
+#if ASSERT_PARALLEL_CALLBACKS
+    subroutine assert_init()
+      implicit none
+      assert_this_image => assert_callback_this_image
+      assert_error_stop => assert_callback_error_stop
+    end subroutine
+    pure function assert_callback_this_image() result(this_image_id)
+      implicit none
+      integer :: this_image_id
+
+      this_image_id = initial_team%this_image
+    end function
+
+    pure subroutine assert_callback_error_stop(stop_code_char)
+      implicit none
+      character(len=*), intent(in) :: stop_code_char
+      character(len=:), allocatable, target :: tmp
+      tmp = stop_code_char
+
+      call caf_fatal_error(tmp)
+    end subroutine
+#else 
+    subroutine assert_init()  
+    end subroutine     
+#endif
+
 end submodule program_startup_s