From d3cf40bc73146ddc16271d967611e414095a2d97 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 14 Mar 2024 14:16:21 -0700 Subject: [PATCH 1/8] chore(assert): rm vendored utility --- src/caffeine/assert/assert_m.F90 | 47 -------- src/caffeine/assert/assert_s.f90 | 90 -------------- src/caffeine/assert/characterizable_m.f90 | 24 ---- src/caffeine/assert/intrinsic_array_m.F90 | 58 --------- src/caffeine/assert/intrinsic_array_s.F90 | 140 ---------------------- 5 files changed, 359 deletions(-) delete mode 100644 src/caffeine/assert/assert_m.F90 delete mode 100644 src/caffeine/assert/assert_s.f90 delete mode 100644 src/caffeine/assert/characterizable_m.f90 delete mode 100644 src/caffeine/assert/intrinsic_array_m.F90 delete mode 100644 src/caffeine/assert/intrinsic_array_s.F90 diff --git a/src/caffeine/assert/assert_m.F90 b/src/caffeine/assert/assert_m.F90 deleted file mode 100644 index efd362008..000000000 --- a/src/caffeine/assert/assert_m.F90 +++ /dev/null @@ -1,47 +0,0 @@ -! -! (c) 2019-2020 Guide Star Engineering, LLC -! This Software was developed for the US Nuclear Regulatory Commission (US NRC) under contract -! "Multi-Dimensional Physics Implementation into Fuel Analysis under Steady-state and Transients (FAST)", -! contract # NRC-HQ-60-17-C-0007 -! -module caffeine_assert_m - !! summary: Utility for runtime checking of logical assertions. - !! usage: error-terminate if the assertion fails: - !! - !! use assertions_m, only : assert - !! call assert( 2 > 1, "2 > 1") - !! - !! Turn off assertions in production code by setting USE_ASSERTIONS to .false. via the preprocessor. - !! This file's capitalized .F90 extension causes most Fortran compilers to preprocess this file so - !! that building as follows turns off assertion enforcement: - !! - !! fpm build --flag "-DUSE_ASSERTIONS=.false." - !! - !! Doing so may eliminate any associated runtime overhead by enabling optimizing compilers to ignore - !! the assertion procedure body during a dead-code-removal phase of optimization. - implicit none - private - public :: assert - -#ifndef USE_ASSERTIONS -# define USE_ASSERTIONS .true. -#endif - logical, parameter :: enforce_assertions=USE_ASSERTIONS - !! Turn off assertions as follows: fpm build --flag "-DUSE_ASSERTIONS=.false." - - interface - - module subroutine assert(assertion, description, diagnostic_data) - !! If assertion is .false., error-terminate with a character stop code that contains diagnostic_data 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" - class(*), intent(in), optional :: diagnostic_data - !! Data to include in an error ouptput: may be of an intrinsic type or a type that extends characterizable_t - end subroutine - - end interface - -end module diff --git a/src/caffeine/assert/assert_s.f90 b/src/caffeine/assert/assert_s.f90 deleted file mode 100644 index 5585e5566..000000000 --- a/src/caffeine/assert/assert_s.f90 +++ /dev/null @@ -1,90 +0,0 @@ -! -! (c) 2019-2020 Guide Star Engineering, LLC -! This Software was developed for the US Nuclear Regulatory Commission (US NRC) under contract -! "Multi-Dimensional Physics Implementation into Fuel Analysis under Steady-state and Transients (FAST)", -! contract # NRC-HQ-60-17-C-0007 -! -submodule(caffeine_assert_m) caffeine_assert_s - use iso_c_binding, only: c_bool - implicit none - -contains - - module procedure assert - use caffeine_characterizable_m, only : characterizable_t - use prif, only: prif_error_stop, this_image => prif_this_image - - character(len=:), allocatable :: header, trailer - integer :: me - - toggle_assertions: & - if (enforce_assertions) then - - check_assertion: & - if (.not. assertion) then - - call this_image(image_index=me) - header = 'Assertion "' // description // '" failed on image ' // string(me) - - represent_diagnostics_as_string: & - if (.not. present(diagnostic_data)) then - - trailer = "(none provided)" - - else - - select type(diagnostic_data) - type is(character(len=*)) - trailer = diagnostic_data - type is(complex) - trailer = string(diagnostic_data) - type is(integer) - trailer = string(diagnostic_data) - type is(logical) - trailer = string(diagnostic_data) - type is(real) - trailer = string(diagnostic_data) - class is(characterizable_t) - trailer = diagnostic_data%as_character() - class default - trailer = "of unsupported type." - end select - - end if represent_diagnostics_as_string - - call prif_error_stop(.false._c_bool, stop_code_char=header // ' with diagnostic data "' // trailer // '"') - - end if check_assertion - - end if toggle_assertions - - contains - - pure function string(numeric) result(number_as_string) - !! Result is a string represention of the numeric argument - class(*), intent(in) :: numeric - integer, parameter :: max_len=128 - character(len=max_len) :: untrimmed_string - character(len=:), allocatable :: number_as_string - - select type(numeric) - type is(complex) - write(untrimmed_string, *) numeric - type is(integer) - write(untrimmed_string, *) numeric - type is(logical) - write(untrimmed_string, *) numeric - type is(real) - write(untrimmed_string, *) numeric - class default - call prif_error_stop(.false._c_bool, & - stop_code_char="Internal error in subroutine 'assert': unsupported type in function 'string'.") - end select - - number_as_string = trim(adjustl(untrimmed_string)) - - end function string - - end procedure - -end submodule diff --git a/src/caffeine/assert/characterizable_m.f90 b/src/caffeine/assert/characterizable_m.f90 deleted file mode 100644 index 66018a616..000000000 --- a/src/caffeine/assert/characterizable_m.f90 +++ /dev/null @@ -1,24 +0,0 @@ -module caffeine_characterizable_m - !! Define an abstract class that supports object representation in character form - implicit none - - private - public :: characterizable_t - - type, abstract :: characterizable_t - contains - procedure(as_character_i), deferred :: as_character - end type - - abstract interface - - pure function as_character_i(self) result(character_self) - import characterizable_t - implicit none - class(characterizable_t), intent(in) :: self - character(len=:), allocatable :: character_self - end function - - end interface - -end module diff --git a/src/caffeine/assert/intrinsic_array_m.F90 b/src/caffeine/assert/intrinsic_array_m.F90 deleted file mode 100644 index df6c2f436..000000000 --- a/src/caffeine/assert/intrinsic_array_m.F90 +++ /dev/null @@ -1,58 +0,0 @@ -module caffeine_intrinsic_array_m - !! Define an abstract class that supports object representation in character form - use caffeine_characterizable_m, only : characterizable_t - implicit none - - private - public :: intrinsic_array_t - - type, extends(characterizable_t) :: intrinsic_array_t - complex, allocatable :: complex_1D(:) - complex(kind(1.D0)), allocatable :: complex_double_1D(:) - integer, allocatable :: integer_1D(:) - logical, allocatable :: logical_1D(:) - real, allocatable :: real_1D(:) - double precision, allocatable :: double_precision_1D(:) - - complex, allocatable :: complex_2D(:,:) - complex(kind(1.D0)), allocatable :: complex_double_2D(:,:) - integer, allocatable :: integer_2D(:,:) - logical, allocatable :: logical_2D(:,:) - real, allocatable :: real_2D(:,:) - double precision, allocatable :: double_precision_2D(:,:) - - complex, allocatable :: complex_3D(:,:,:) - complex(kind(1.D0)), allocatable :: complex_double_3D(:,:,:) - integer, allocatable :: integer_3D(:,:,:) - logical, allocatable :: logical_3D(:,:,:) - real, allocatable :: real_3D(:,:,:) - double precision, allocatable :: double_precision_3D(:,:,:) - contains - procedure :: as_character - end type - - interface intrinsic_array_t - - pure module function construct(array) result(intrinsic_array) - implicit none -#ifndef NAGFOR - class(*), intent(in) :: array(..) -#else - class(*), intent(in) :: array(:) -#endif - type(intrinsic_array_t) intrinsic_array - end function - - end interface - - interface - - pure module function as_character(self) result(character_self) - implicit none - class(intrinsic_array_t), intent(in) :: self - character(len=:), allocatable :: character_self - end function - - end interface - -end module diff --git a/src/caffeine/assert/intrinsic_array_s.F90 b/src/caffeine/assert/intrinsic_array_s.F90 deleted file mode 100644 index 3ddc44094..000000000 --- a/src/caffeine/assert/intrinsic_array_s.F90 +++ /dev/null @@ -1,140 +0,0 @@ -submodule(caffeine_intrinsic_array_m) caffeine_intrinsic_array_s - use iso_c_binding, only: c_bool - use prif, only: prif_error_stop - implicit none - -contains - - module procedure construct - -#ifndef NAGFOR - select rank(array) - rank(1) -#endif - select type(array) - type is(complex) - intrinsic_array%complex_1D = array - type is(integer) - intrinsic_array%integer_1D = array - type is(logical) - intrinsic_array%logical_1D = array - type is(real) - intrinsic_array%real_1D = array - type is(double precision) - intrinsic_array%double_precision_1D = array - class default - call prif_error_stop(.false._c_bool, stop_code_char="intrinsic_array_t construct: unsupported rank-2 type") - end select -#ifndef NAGFOR - rank(2) - select type(array) - type is(complex) - intrinsic_array%complex_2D = array - type is(integer) - intrinsic_array%integer_2D = array - type is(logical) - intrinsic_array%logical_2D = array - type is(real) - intrinsic_array%real_2D = array - type is(double precision) - intrinsic_array%double_precision_2D = array - class default - call prif_error_stop(.false._c_bool, stop_code_char="intrinsic_array_t construct: unsupported rank-2 type") - end select - - rank(3) - select type(array) - type is(complex) - intrinsic_array%complex_3D = array - type is(integer) - intrinsic_array%integer_3D = array - type is(logical) - intrinsic_array%logical_3D = array - type is(real) - intrinsic_array%real_3D = array - type is(double precision) - intrinsic_array%double_precision_3D = array - class default - call prif_error_stop(.false._c_bool, stop_code_char="intrinsic_array_t construct: unsupported rank-3 type") - end select - - rank default - call prif_error_stop(.false._c_bool, stop_code_char="intrinsic_array_t construct: unsupported rank") - end select -#endif - - end procedure - - module procedure as_character - integer, parameter :: single_number_width=32 - - if (1 /= count( & - [ allocated(self%complex_1D), allocated(self%complex_double_1D), allocated(self%integer_1D), & - allocated(self%logical_1D), allocated(self%real_1D), & - allocated(self%complex_2D), allocated(self%complex_double_2D), allocated(self%integer_2D), & - allocated(self%logical_2D), allocated(self%real_2D), & - allocated(self%complex_3D), allocated(self%complex_double_3D), allocated(self%integer_3D), & - allocated(self%logical_3D), allocated(self%real_3D) & - ])) call prif_error_stop(.false._c_bool, & - stop_code_char="intrinsic_array_t as_character: ambiguous component allocation status.") - - if (allocated(self%complex_1D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%complex_1D)) - write(character_self, *) self%complex_1D - else if (allocated(self%complex_double_1D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_1D)) - write(character_self, *) self%complex_double_1D - else if (allocated(self%integer_1D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%integer_1D)) - write(character_self, *) self%integer_1D - else if (allocated(self%logical_1D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%logical_1D)) - write(character_self, *) self%logical_1D - else if (allocated(self%real_1D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%real_1D)) - write(character_self, *) self%real_1D - else if (allocated(self%double_precision_1D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_1D)) - write(character_self, *) self%double_precision_1D - else if (allocated(self%complex_2D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%complex_2D)) - write(character_self, *) self%complex_2D - else if (allocated(self%complex_double_2D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_2D)) - write(character_self, *) self%complex_double_2D - else if (allocated(self%integer_2D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%integer_2D)) - write(character_self, *) self%integer_2D - else if (allocated(self%logical_2D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%logical_1D)) - write(character_self, *) self%logical_2D - else if (allocated(self%real_2D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%real_2D)) - write(character_self, *) self%real_2D - else if (allocated(self%double_precision_2D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_2D)) - write(character_self, *) self%double_precision_2D - else if (allocated(self%complex_3D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%complex_3D)) - write(character_self, *) self%complex_3D - else if (allocated(self%complex_double_3D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_3D)) - write(character_self, *) self%complex_double_3D - else if (allocated(self%integer_3D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%integer_3D)) - write(character_self, *) self%integer_3D - else if (allocated(self%logical_3D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%logical_1D)) - write(character_self, *) self%logical_3D - else if (allocated(self%real_3D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%real_3D)) - write(character_self, *) self%real_3D - else if (allocated(self%double_precision_3D)) then - character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_3D)) - write(character_self, *) self%double_precision_3D - end if - - character_self = trim(adjustl(character_self)) - end procedure - -end submodule From 6b42a9c6a03b60d3eb3145295e8d3f2912bf0dd4 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 14 Mar 2024 14:51:54 -0700 Subject: [PATCH 2/8] chore: add custom assertion utility --- .../caffeine_assert/caffeine_assert_m.F90 | 28 +++++++++++++++++++ .../caffeine_assert/caffeine_assert_s.f90 | 27 ++++++++++++++++++ .../collective_subroutines/co_reduce_s.f90 | 3 +- 3 files changed, 56 insertions(+), 2 deletions(-) create mode 100644 src/caffeine/caffeine_assert/caffeine_assert_m.F90 create mode 100644 src/caffeine/caffeine_assert/caffeine_assert_s.f90 diff --git a/src/caffeine/caffeine_assert/caffeine_assert_m.F90 b/src/caffeine/caffeine_assert/caffeine_assert_m.F90 new file mode 100644 index 000000000..a141cb32d --- /dev/null +++ b/src/caffeine/caffeine_assert/caffeine_assert_m.F90 @@ -0,0 +1,28 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module caffeine_assert_m + implicit none + + private + public :: assert + +#ifndef ASSERTIONS +#define ASSERTIONS .true. +#endif + + logical, parameter :: assertions_=ASSERTIONS + !! Turn off assertions with + !! fpm test --flag "-DASSERTIONS=.false." + + interface + + pure module subroutine assert(assertion, description, diagnostics) + implicit none + logical, intent(in) :: assertion + character(len=*), intent(in) :: description + class(*), intent(in), optional :: diagnostics + end subroutine + + end interface + +end module caffeine_assert_m diff --git a/src/caffeine/caffeine_assert/caffeine_assert_s.f90 b/src/caffeine/caffeine_assert/caffeine_assert_s.f90 new file mode 100644 index 000000000..9c2b7f9ee --- /dev/null +++ b/src/caffeine/caffeine_assert/caffeine_assert_s.f90 @@ -0,0 +1,27 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +submodule(caffeine_assert_m) caffeine_assert_s + implicit none + +contains + + module procedure assert + character(len=:), allocatable :: tail + + if (assertions_) then + if (.not. present(diagnostics)) then + tail = "." + else + tail = " with diagnostic " + select type(diagnostics) + type is(character(len=*)) + tail = tail // diagnostics + class default + tail = tail // "of unsupported type." + end select + end if + if (.not. assertion) error stop 'Assertion "'// description // tail + end if + end procedure + +end submodule caffeine_assert_s diff --git a/src/caffeine/collective_subroutines/co_reduce_s.f90 b/src/caffeine/collective_subroutines/co_reduce_s.f90 index 092888e9c..c95af598d 100644 --- a/src/caffeine/collective_subroutines/co_reduce_s.f90 +++ b/src/caffeine/collective_subroutines/co_reduce_s.f90 @@ -5,7 +5,6 @@ c_loc, c_null_ptr, c_funloc, c_associated, c_f_pointer, c_f_procpointer, c_char, c_int64_t, c_double, & c_float, c_int32_t use caffeine_assert_m, only : assert - use caffeine_intrinsic_array_m, only : intrinsic_array_t use utilities_m, only : get_c_ptr, get_c_ptr_character, optional_value use caffeine_h_m, only : caf_co_reduce, caf_same_cfi_type, caf_elem_len, caf_is_f_string @@ -272,7 +271,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)", intrinsic_array_t(c_associated_args)) + call assert(all(c_associated_args), "Coll_ReduceSub_c_char: all(c_associated_args)") end associate call c_f_pointer(cdata, arglen) From d0539c7843705e900b2f80aa17c69011f81cb2bd Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Wed, 20 Mar 2024 10:54:23 -0700 Subject: [PATCH 3/8] Turn assertions on by default Co-authored-by: Dan Bonachea --- src/caffeine/caffeine_assert/caffeine_assert_m.F90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/caffeine/caffeine_assert/caffeine_assert_m.F90 b/src/caffeine/caffeine_assert/caffeine_assert_m.F90 index a141cb32d..8a97ffa37 100644 --- a/src/caffeine/caffeine_assert/caffeine_assert_m.F90 +++ b/src/caffeine/caffeine_assert/caffeine_assert_m.F90 @@ -6,13 +6,14 @@ module caffeine_assert_m private public :: assert -#ifndef ASSERTIONS -#define ASSERTIONS .true. +#if CAF_ASSERTIONS || !defined(CAF_ASSERTIONS) + logical, parameter :: assertions_=.true. +#else + logical, parameter :: assertions_=.false. #endif - logical, parameter :: assertions_=ASSERTIONS - !! Turn off assertions with - !! fpm test --flag "-DASSERTIONS=.false." + !! Disable assertions with + !! fpm test --flag "-DCAF_ASSERTIONS=0" interface From 89d5a8f608c27b94cb88f0196eb675c3636afd94 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Wed, 20 Mar 2024 11:58:58 -0700 Subject: [PATCH 4/8] fix(assert): call prif_error_stop --- src/caffeine/caffeine_assert/caffeine_assert_s.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/caffeine/caffeine_assert/caffeine_assert_s.f90 b/src/caffeine/caffeine_assert/caffeine_assert_s.f90 index 9c2b7f9ee..1c5dad985 100644 --- a/src/caffeine/caffeine_assert/caffeine_assert_s.f90 +++ b/src/caffeine/caffeine_assert/caffeine_assert_s.f90 @@ -1,6 +1,8 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt submodule(caffeine_assert_m) caffeine_assert_s + use prif, only : prif_error_stop + use iso_c_binding, only : c_bool implicit none contains @@ -12,7 +14,7 @@ if (.not. present(diagnostics)) then tail = "." else - tail = " with diagnostic " + tail = " with diagnostics " select type(diagnostics) type is(character(len=*)) tail = tail // diagnostics @@ -20,7 +22,7 @@ tail = tail // "of unsupported type." end select end if - if (.not. assertion) error stop 'Assertion "'// description // tail + if (.not. assertion) call prif_error_stop(.false._c_bool, stop_code_char='Assertion "'// description // '" failed' // tail) end if end procedure From 0a63577d899b4d9c83d79705b7cdd0c034509296 Mon Sep 17 00:00:00 2001 From: Katherine Rasmussen Date: Thu, 21 Mar 2024 12:29:05 -0700 Subject: [PATCH 5/8] Move `caffeine_assert_s` to extend `prif_private_s`. --- .../caffeine_assert/caffeine_assert_m.F90 | 29 ------------------- ...ine_assert_s.f90 => caffeine_assert_s.F90} | 13 +++++++-- .../collective_subroutines/co_max_s.f90 | 1 - .../collective_subroutines/co_min_s.f90 | 1 - .../collective_subroutines/co_reduce_s.f90 | 1 - src/caffeine/prif_private_s.f90 | 11 +++++++ src/caffeine/prif_queries_s.f90 | 1 - test/caf_co_reduce_test.f90 | 9 ++++-- 8 files changed, 27 insertions(+), 39 deletions(-) delete mode 100644 src/caffeine/caffeine_assert/caffeine_assert_m.F90 rename src/caffeine/caffeine_assert/{caffeine_assert_s.f90 => caffeine_assert_s.F90} (73%) diff --git a/src/caffeine/caffeine_assert/caffeine_assert_m.F90 b/src/caffeine/caffeine_assert/caffeine_assert_m.F90 deleted file mode 100644 index 8a97ffa37..000000000 --- a/src/caffeine/caffeine_assert/caffeine_assert_m.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! Copyright (c), The Regents of the University of California -! Terms of use are as specified in LICENSE.txt -module caffeine_assert_m - implicit none - - private - public :: assert - -#if CAF_ASSERTIONS || !defined(CAF_ASSERTIONS) - logical, parameter :: assertions_=.true. -#else - logical, parameter :: assertions_=.false. -#endif - - !! Disable assertions with - !! fpm test --flag "-DCAF_ASSERTIONS=0" - - interface - - pure module subroutine assert(assertion, description, diagnostics) - implicit none - logical, intent(in) :: assertion - character(len=*), intent(in) :: description - class(*), intent(in), optional :: diagnostics - end subroutine - - end interface - -end module caffeine_assert_m diff --git a/src/caffeine/caffeine_assert/caffeine_assert_s.f90 b/src/caffeine/caffeine_assert/caffeine_assert_s.F90 similarity index 73% rename from src/caffeine/caffeine_assert/caffeine_assert_s.f90 rename to src/caffeine/caffeine_assert/caffeine_assert_s.F90 index 1c5dad985..692380b2b 100644 --- a/src/caffeine/caffeine_assert/caffeine_assert_s.f90 +++ b/src/caffeine/caffeine_assert/caffeine_assert_s.F90 @@ -1,10 +1,17 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt -submodule(caffeine_assert_m) caffeine_assert_s - use prif, only : prif_error_stop - use iso_c_binding, only : c_bool +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 with + !! fpm test --flag "-DCAF_ASSERTIONS=0" + contains module procedure assert diff --git a/src/caffeine/collective_subroutines/co_max_s.f90 b/src/caffeine/collective_subroutines/co_max_s.f90 index 22aa2f544..ed8d52d3b 100644 --- a/src/caffeine/collective_subroutines/co_max_s.f90 +++ b/src/caffeine/collective_subroutines/co_max_s.f90 @@ -4,7 +4,6 @@ use iso_c_binding, only : c_null_char, c_f_pointer, c_funloc, c_null_ptr use utilities_m, only : get_c_ptr, get_c_ptr_character, optional_value use caffeine_h_m, only : caf_co_max, caf_same_cfi_type, caf_numeric_type, caf_is_f_string - use caffeine_assert_m, only : assert implicit none diff --git a/src/caffeine/collective_subroutines/co_min_s.f90 b/src/caffeine/collective_subroutines/co_min_s.f90 index d7973770a..8fea20e9d 100644 --- a/src/caffeine/collective_subroutines/co_min_s.f90 +++ b/src/caffeine/collective_subroutines/co_min_s.f90 @@ -4,7 +4,6 @@ use iso_c_binding, only : c_null_char, c_f_pointer, c_funloc, c_null_ptr use utilities_m, only : get_c_ptr, get_c_ptr_character, optional_value use caffeine_h_m, only : caf_co_min, caf_same_cfi_type, caf_numeric_type, caf_is_f_string - use caffeine_assert_m, only : assert implicit none diff --git a/src/caffeine/collective_subroutines/co_reduce_s.f90 b/src/caffeine/collective_subroutines/co_reduce_s.f90 index c95af598d..46776a118 100644 --- a/src/caffeine/collective_subroutines/co_reduce_s.f90 +++ b/src/caffeine/collective_subroutines/co_reduce_s.f90 @@ -4,7 +4,6 @@ use iso_c_binding, only : & c_loc, c_null_ptr, c_funloc, c_associated, c_f_pointer, c_f_procpointer, c_char, c_int64_t, c_double, & c_float, c_int32_t - use caffeine_assert_m, only : assert use utilities_m, only : get_c_ptr, get_c_ptr_character, optional_value use caffeine_h_m, only : caf_co_reduce, caf_same_cfi_type, caf_elem_len, caf_is_f_string diff --git a/src/caffeine/prif_private_s.f90 b/src/caffeine/prif_private_s.f90 index 13bfc809a..cafde16e4 100644 --- a/src/caffeine/prif_private_s.f90 +++ b/src/caffeine/prif_private_s.f90 @@ -7,6 +7,17 @@ type(prif_team_type), pointer :: current_team => null() type(c_ptr) :: non_symmetric_heap_mspace + interface + + pure module subroutine assert(assertion, description, diagnostics) + implicit none + logical, intent(in) :: assertion + character(len=*), intent(in) :: description + class(*), intent(in), optional :: diagnostics + end subroutine + + end interface + contains subroutine unimplemented(proc_name) diff --git a/src/caffeine/prif_queries_s.f90 b/src/caffeine/prif_queries_s.f90 index e385ed679..e3a75b8c4 100644 --- a/src/caffeine/prif_queries_s.f90 +++ b/src/caffeine/prif_queries_s.f90 @@ -1,7 +1,6 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt submodule(prif:prif_private_s) prif_queries_s - use caffeine_assert_m, only: assert use caffeine_h_m, only: caf_convert_base_addr implicit none diff --git a/test/caf_co_reduce_test.f90 b/test/caf_co_reduce_test.f90 index 31909d5fb..19360655c 100644 --- a/test/caf_co_reduce_test.f90 +++ b/test/caf_co_reduce_test.f90 @@ -1,7 +1,6 @@ module caf_co_reduce_test - use prif, only : prif_co_reduce, prif_num_images, prif_this_image + use prif, only : prif_co_reduce, prif_num_images, prif_this_image, prif_error_stop use veggies, only : result_t, test_item_t, assert_equals, describe, it, assert_that, assert_equals - use caffeine_assert_m, only : assert use iso_c_binding, only : c_bool, c_funloc, c_char, c_double, c_int64_t implicit none @@ -49,7 +48,11 @@ function alphabetically_1st_size1_string_array() result(result_) function alphabetize(lhs, rhs) result(first_alphabetically) character(len=*), intent(in) :: lhs, rhs character(len=:), allocatable :: first_alphabetically - call assert(len(lhs)==len(rhs), "co_reduce_s alphabetize: LHS/RHS length match", lhs//" , "//rhs) + + if (len(lhs).ne.len(rhs)) then + call prif_error_stop(quiet=.false._c_bool, & + stop_code_char="co_reduce_s alphabetize: LHS(" // lhs // ")/RHS(" // rhs // ") length don't match") + end if first_alphabetically = min(lhs,rhs) end function From c3bdb890e37e9ed764445b35e550b2d572295149 Mon Sep 17 00:00:00 2001 From: Katherine Rasmussen Date: Thu, 21 Mar 2024 12:30:32 -0700 Subject: [PATCH 6/8] Move `caffeine_assert_s` up one dir since it became only file in the `caffeine_assert` dir after last change. --- src/caffeine/{caffeine_assert => }/caffeine_assert_s.F90 | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/caffeine/{caffeine_assert => }/caffeine_assert_s.F90 (100%) diff --git a/src/caffeine/caffeine_assert/caffeine_assert_s.F90 b/src/caffeine/caffeine_assert_s.F90 similarity index 100% rename from src/caffeine/caffeine_assert/caffeine_assert_s.F90 rename to src/caffeine/caffeine_assert_s.F90 From f2e55bc15a8fef5622492c703840aa2295a76006 Mon Sep 17 00:00:00 2001 From: Katherine Rasmussen Date: Tue, 26 Mar 2024 10:52:00 -0700 Subject: [PATCH 7/8] Address review comments by restructuring conditional logic in new assertion routine. --- src/caffeine/caffeine_assert_s.F90 | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/src/caffeine/caffeine_assert_s.F90 b/src/caffeine/caffeine_assert_s.F90 index 692380b2b..3c9eb5be4 100644 --- a/src/caffeine/caffeine_assert_s.F90 +++ b/src/caffeine/caffeine_assert_s.F90 @@ -18,18 +18,21 @@ character(len=:), allocatable :: tail if (assertions_) 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 + 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 - if (.not. assertion) call prif_error_stop(.false._c_bool, stop_code_char='Assertion "'// description // '" failed' // tail) end if end procedure From 7404cd0153022dd817afdcbe82b65abd99adf808 Mon Sep 17 00:00:00 2001 From: Katherine Rasmussen Date: Tue, 26 Mar 2024 10:59:40 -0700 Subject: [PATCH 8/8] Update src/caffeine/caffeine_assert_s.F90 Co-authored-by: Dan Bonachea --- src/caffeine/caffeine_assert_s.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/caffeine/caffeine_assert_s.F90 b/src/caffeine/caffeine_assert_s.F90 index 3c9eb5be4..a03839778 100644 --- a/src/caffeine/caffeine_assert_s.F90 +++ b/src/caffeine/caffeine_assert_s.F90 @@ -9,8 +9,7 @@ logical, parameter :: assertions_=.false. #endif - !! Disable assertions with - !! fpm test --flag "-DCAF_ASSERTIONS=0" + !! Disable assertions by compiling with preprocessor setting: -DCAF_ASSERTIONS=0 contains