diff --git a/install.sh b/install.sh index ff5a63739..04feec8a3 100755 --- a/install.sh +++ b/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 diff --git a/manifest/fpm.toml.template b/manifest/fpm.toml.template index 9ca3133aa..fc3885a10 100644 --- a/manifest/fpm.toml.template +++ b/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"} diff --git a/src/caffeine/caffeine.c b/src/caffeine/caffeine.c index 34d5ce9f9..be4c44d22 100644 --- a/src/caffeine/caffeine.c +++ b/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); diff --git a/src/caffeine/caffeine_assert_s.F90 b/src/caffeine/caffeine_assert_s.F90 deleted file mode 100644 index a03839778..000000000 --- a/src/caffeine/caffeine_assert_s.F90 +++ /dev/null @@ -1,38 +0,0 @@ -! Copyright (c), The Regents of the University of California -! Terms of use are as specified in LICENSE.txt -submodule(prif:prif_private_s) caffeine_assert_s - implicit none - -#if CAF_ASSERTIONS || !defined(CAF_ASSERTIONS) - logical, parameter :: assertions_=.true. -#else - logical, parameter :: assertions_=.false. -#endif - - !! Disable assertions by compiling with preprocessor setting: -DCAF_ASSERTIONS=0 - -contains - - module procedure assert - character(len=:), allocatable :: tail - - if (assertions_) then - if (.not. assertion) then - if (.not. present(diagnostics)) then - tail = "." - else - tail = " with diagnostics " - select type(diagnostics) - type is(character(len=*)) - tail = tail // diagnostics - class default - tail = tail // "of unsupported type." - end select - end if - - call prif_error_stop(.false._c_bool, stop_code_char='Assertion "'// description // '" failed' // tail) - end if - end if - end procedure - -end submodule caffeine_assert_s diff --git a/src/caffeine/collective_subroutines/co_max_s.f90 b/src/caffeine/collective_subroutines/co_max_s.F90 similarity index 88% rename from src/caffeine/collective_subroutines/co_max_s.f90 rename to src/caffeine/collective_subroutines/co_max_s.F90 index fc3e562df..a99d8d582 100644 --- a/src/caffeine/collective_subroutines/co_max_s.f90 +++ b/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 diff --git a/src/caffeine/collective_subroutines/co_min_s.f90 b/src/caffeine/collective_subroutines/co_min_s.F90 similarity index 88% rename from src/caffeine/collective_subroutines/co_min_s.f90 rename to src/caffeine/collective_subroutines/co_min_s.F90 index c2b4361b3..b5eea6a22 100644 --- a/src/caffeine/collective_subroutines/co_min_s.f90 +++ b/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 diff --git a/src/caffeine/collective_subroutines/co_reduce_s.f90 b/src/caffeine/collective_subroutines/co_reduce_s.F90 similarity index 90% rename from src/caffeine/collective_subroutines/co_reduce_s.f90 rename to src/caffeine/collective_subroutines/co_reduce_s.F90 index 9f322da7f..b2d942022 100644 --- a/src/caffeine/collective_subroutines/co_reduce_s.f90 +++ b/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) diff --git a/src/caffeine/prif_private_s.f90 b/src/caffeine/prif_private_s.f90 index 75feb66e5..7862c3db6 100644 --- a/src/caffeine/prif_private_s.f90 +++ b/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) diff --git a/src/caffeine/program_startup_s.F90 b/src/caffeine/program_startup_s.F90 index 230ee90bc..a8c932eb2 100644 --- a/src/caffeine/program_startup_s.F90 +++ b/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