diff --git a/src/caffeine/allocation_s.F90 b/src/caffeine/allocation_s.F90 index 2b71ce22..4868d0b5 100644 --- a/src/caffeine/allocation_s.F90 +++ b/src/caffeine/allocation_s.F90 @@ -43,6 +43,7 @@ module subroutine prif_allocate_coarray(lcobounds, ucobounds, size_in_bytes, & integer(c_int) :: corank type(prif_coarray_descriptor), pointer :: cdp + call_assert(prif_init_called_previously) call_assert(team_check(current_team)) corank = size(lcobounds) @@ -137,6 +138,8 @@ module subroutine prif_allocate_coarray(lcobounds, ucobounds, size_in_bytes, & module procedure prif_allocate type(c_ptr) :: mem + call_assert(prif_init_called_previously) + mem = caf_allocate_non_symmetric(size_in_bytes) if (.not. c_associated(mem)) then call report_error(PRIF_STAT_OUT_OF_MEMORY, out_of_memory_message(size_in_bytes, .false.), & @@ -208,6 +211,7 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) character(len=:), allocatable :: local_errmsg # endif + call_assert(prif_init_called_previously) call prif_sync_all ! Need to ensure we don't deallocate anything till everyone gets here num_handles = size(coarray_handles) if (.not. all([(c_associated(coarray_handles(i)%info), i = 1, num_handles)])) then @@ -258,6 +262,7 @@ subroutine coarray_cleanup_i(handle, stat, errmsg) bind(C) end procedure module procedure prif_deallocate + call_assert(prif_init_called_previously) call caf_deallocate_non_symmetric(mem) if (present(stat)) stat = 0 end procedure diff --git a/src/caffeine/co_broadcast_s.F90 b/src/caffeine/co_broadcast_s.F90 index a4ec6913..c9838274 100644 --- a/src/caffeine/co_broadcast_s.F90 +++ b/src/caffeine/co_broadcast_s.F90 @@ -11,6 +11,7 @@ contains module procedure prif_co_broadcast + call_assert(prif_init_called_previously) call_assert(source_image >= 1 .and. source_image <= current_team%info%num_images) call contiguous_co_broadcast(a, source_image, stat, errmsg, errmsg_alloc) end procedure @@ -29,6 +30,7 @@ subroutine contiguous_co_broadcast(a, source_image, stat, errmsg, errmsg_alloc) end subroutine module procedure prif_co_broadcast_cptr + call_assert(prif_init_called_previously) call_assert(source_image >= 1 .and. source_image <= current_team%info%num_images) if (present(stat)) stat=0 call caf_co_broadcast_cptr(a_ptr, source_image, size_in_bytes, current_team%info%gex_team) diff --git a/src/caffeine/co_max_s.F90 b/src/caffeine/co_max_s.F90 index 29f6bbb4..5cc30217 100644 --- a/src/caffeine/co_max_s.F90 +++ b/src/caffeine/co_max_s.F90 @@ -40,6 +40,7 @@ subroutine caf_char_max_wrapper(arg1, arg2_and_out, count, cdata) bind(C) contains module procedure prif_co_max + call_assert(prif_init_called_previously) if (present(result_image)) then call_assert(result_image >= 1 .and. result_image <= current_team%info%num_images) endif @@ -68,6 +69,7 @@ subroutine contiguous_co_max(a, result_image, stat, errmsg, errmsg_alloc) integer(c_size_t), target :: char_len procedure(prif_operation_wrapper_interface), pointer :: op + call_assert(prif_init_called_previously) char_len = len(a) op => caf_char_max_wrapper #if defined(__GFORTRAN__) && 0 diff --git a/src/caffeine/co_min_s.F90 b/src/caffeine/co_min_s.F90 index 0cd285a2..0b7d0215 100644 --- a/src/caffeine/co_min_s.F90 +++ b/src/caffeine/co_min_s.F90 @@ -40,6 +40,7 @@ subroutine caf_char_min_wrapper(arg1, arg2_and_out, count, cdata) bind(C) contains module procedure prif_co_min + call_assert(prif_init_called_previously) if (present(result_image)) then call_assert(result_image >= 1 .and. result_image <= current_team%info%num_images) endif @@ -68,6 +69,7 @@ subroutine contiguous_co_min(a, result_image, stat, errmsg, errmsg_alloc) integer(c_size_t), target :: char_len procedure(prif_operation_wrapper_interface), pointer :: op + call_assert(prif_init_called_previously) char_len = len(a) op => caf_char_min_wrapper #if defined(__GFORTRAN__) && 0 diff --git a/src/caffeine/co_reduce_s.F90 b/src/caffeine/co_reduce_s.F90 index bdb287c7..6a295051 100644 --- a/src/caffeine/co_reduce_s.F90 +++ b/src/caffeine/co_reduce_s.F90 @@ -18,6 +18,7 @@ module subroutine prif_co_reduce(a, operation_wrapper, cdata, result_image, stat integer(c_int), intent(out), optional :: stat character(len=*), intent(inout), optional :: errmsg character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + call_assert(prif_init_called_previously) if (present(result_image)) then call_assert(result_image >= 1 .and. result_image <= current_team%info%num_images) endif @@ -63,6 +64,7 @@ module subroutine prif_co_reduce_cptr(a_ptr, element_size, element_count, operat character(len=:), intent(inout), allocatable, optional :: errmsg_alloc type(c_funptr) :: funptr + call_assert(prif_init_called_previously) if (present(stat)) stat=0 call_assert(associated(operation_wrapper)) diff --git a/src/caffeine/co_sum_s.F90 b/src/caffeine/co_sum_s.F90 index caeca2e5..55026f4c 100644 --- a/src/caffeine/co_sum_s.F90 +++ b/src/caffeine/co_sum_s.F90 @@ -11,6 +11,7 @@ contains module procedure prif_co_sum + call_assert(prif_init_called_previously) if (present(result_image)) then call_assert(result_image >= 1 .and. result_image <= current_team%info%num_images) endif diff --git a/src/caffeine/coarray_access_s.F90 b/src/caffeine/coarray_access_s.F90 index 368d3ffa..18eec7e9 100644 --- a/src/caffeine/coarray_access_s.F90 +++ b/src/caffeine/coarray_access_s.F90 @@ -26,6 +26,7 @@ end procedure module procedure prif_put_indirect + call_assert(prif_init_called_previously) call_assert_describe(image_num > 0 .and. image_num <= initial_team%num_images, "image_num not within valid range") call caf_put( & @@ -87,6 +88,7 @@ end procedure module procedure prif_put_indirect_with_notify_indirect + call_assert(prif_init_called_previously) call_assert_describe(image_num > 0 .and. image_num <= initial_team%num_images, "image_num not within valid range") call caf_put( & @@ -118,6 +120,7 @@ end procedure module procedure prif_get_indirect + call_assert(prif_init_called_previously) call_assert_describe(image_num > 0 .and. image_num <= initial_team%num_images, "image_num not within valid range") call caf_get( & @@ -183,6 +186,7 @@ subroutine get_strided_helper( & end procedure module procedure prif_get_strided_indirect + call_assert(prif_init_called_previously) call get_strided_helper( & image_num = image_num, & remote_ptr = remote_ptr, & @@ -248,6 +252,7 @@ subroutine put_strided_helper( & end procedure module procedure prif_put_strided_indirect + call_assert(prif_init_called_previously) call put_strided_helper( & image_num = image_num, & remote_ptr = remote_ptr, & @@ -320,6 +325,7 @@ subroutine put_strided_helper( & end procedure module procedure prif_put_strided_indirect_with_notify_indirect + call_assert(prif_init_called_previously) call put_strided_helper( & image_num = image_num, & remote_ptr = remote_ptr, & diff --git a/src/caffeine/events_s.F90 b/src/caffeine/events_s.F90 index 1184356a..f1b92afb 100644 --- a/src/caffeine/events_s.F90 +++ b/src/caffeine/events_s.F90 @@ -24,6 +24,7 @@ end procedure module procedure prif_event_post_indirect + call_assert(prif_init_called_previously) call_assert_describe(image_num > 0 .and. image_num <= initial_team%num_images, "image_num not within valid range") call caf_event_post(image_num, event_var_ptr, & @@ -35,6 +36,7 @@ module procedure prif_event_wait integer(c_int64_t) :: threshold + call_assert(prif_init_called_previously) if (present(until_count)) then threshold = MAX(until_count, 1_c_int64_t) else @@ -47,6 +49,7 @@ end procedure module procedure prif_event_query + call_assert(prif_init_called_previously) call caf_event_query(event_var_ptr, count) if (present(stat)) stat = 0 @@ -55,6 +58,7 @@ module procedure prif_notify_wait integer(c_int64_t) :: threshold + call_assert(prif_init_called_previously) if (present(until_count)) then threshold = MAX(until_count, 1_c_int64_t) else diff --git a/src/caffeine/locks_s.F90 b/src/caffeine/locks_s.F90 index f4ef5123..c5edeff5 100644 --- a/src/caffeine/locks_s.F90 +++ b/src/caffeine/locks_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) locks_s ! DO NOT ADD USE STATEMENTS HERE ! All use statements belong in prif_private_s.F90 @@ -14,6 +17,7 @@ end procedure module procedure prif_lock_indirect + call_assert(prif_init_called_previously) call unimplemented("prif_lock_indirect") if (present(stat)) stat = 0 @@ -26,6 +30,7 @@ end procedure module procedure prif_unlock_indirect + call_assert(prif_init_called_previously) call unimplemented("prif_unlock_indirect") if (present(stat)) stat = 0 diff --git a/src/caffeine/prif_private_s.F90 b/src/caffeine/prif_private_s.F90 index f732305a..e018c5fd 100644 --- a/src/caffeine/prif_private_s.F90 +++ b/src/caffeine/prif_private_s.F90 @@ -27,6 +27,7 @@ type(prif_team_descriptor), target :: initial_team type(prif_team_type) :: current_team integer(c_intptr_t) :: total_heap_size, non_symmetric_heap_size + logical, save :: prif_init_called_previously = .false. interface @@ -548,6 +549,8 @@ elemental impure function coarray_handle_check(coarray_handle) result(result_) integer(c_int) :: i, epp(15) type(prif_coarray_descriptor), pointer :: cdp + call assert_always(prif_init_called_previously, "Invalid call to a PRIF subroutine before prif::prif_init") + call assert_always(c_associated(coarray_handle%info), "unassociated info pointer in prif_coarray_handle") cdp => handle_to_cdp(coarray_handle) associate(corank => cdp%corank) @@ -578,6 +581,7 @@ recursive function team_check(team, known_active, cycle_check) result(result_) logical :: result_, known_active_ integer :: i + call assert_always(prif_init_called_previously, "Invalid call to a PRIF subroutine before prif::prif_init") call assert_always(associated(team%info), "unassociated info pointer in prif_team_type") ! check for invalid cycles in the team hierarchy diff --git a/src/caffeine/program_startup_s.F90 b/src/caffeine/program_startup_s.F90 index 5f04e8ae..1a6cb4d8 100644 --- a/src/caffeine/program_startup_s.F90 +++ b/src/caffeine/program_startup_s.F90 @@ -11,7 +11,9 @@ module procedure prif_init use ieee_arithmetic, only: ieee_inexact, ieee_set_flag - logical, save :: prif_init_called_previously = .false. + logical, save :: shadow_init = .false. + + call_assert(shadow_init .eqv. prif_init_called_previously) if (prif_init_called_previously) then stat = PRIF_STAT_ALREADY_INIT @@ -30,6 +32,9 @@ initial_team%num_images = caf_num_images(initial_team%gex_team) non_symmetric_heap_size = total_heap_size - initial_team%heap_size + prif_init_called_previously = .true. + shadow_init = .true. + call_assert(team_check(current_team)) call sync_init() @@ -38,7 +43,6 @@ ! signalled from within the C-based initialization code above call ieee_set_flag(ieee_inexact, .false.) - prif_init_called_previously = .true. stat = 0 end if end procedure diff --git a/src/caffeine/program_termination_s.F90 b/src/caffeine/program_termination_s.F90 index fad8dea2..09a28ebd 100644 --- a/src/caffeine/program_termination_s.F90 +++ b/src/caffeine/program_termination_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) program_termination_s ! DO NOT ADD USE STATEMENTS HERE ! All use statements belong in prif_private_s.F90 @@ -32,6 +35,7 @@ subroutine flush_all() module procedure prif_stop + call_assert(prif_init_called_previously) call flush_all() call prif_sync_all @@ -87,6 +91,7 @@ end subroutine prif_stop_character module procedure prif_error_stop + call_assert(prif_init_called_previously) call flush_all() call run_callbacks(.true._c_bool, quiet, stop_code_int, stop_code_char) @@ -135,6 +140,7 @@ subroutine prif_error_stop_integer(quiet, stop_code) end subroutine module procedure prif_fail_image + call_assert(prif_init_called_previously) # ifndef CAF_FAIL_IMAGE_SUPPRESS_FLUSH call flush_all() # endif diff --git a/src/caffeine/sync_stmt_s.F90 b/src/caffeine/sync_stmt_s.F90 index 5070c039..acc18497 100644 --- a/src/caffeine/sync_stmt_s.F90 +++ b/src/caffeine/sync_stmt_s.F90 @@ -29,6 +29,7 @@ end procedure module procedure prif_sync_memory + call_assert(prif_init_called_previously) call caf_sync_memory if (present(stat)) stat = 0 end procedure