From 0fb66d4de325aa483b6daa69dc5c049389ff3f75 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Thu, 30 Apr 2026 20:19:54 -0700 Subject: [PATCH 1/6] test/prif_allocate_test: Fix test compilation error on GFortran 16.1 This particular part of the test code is unreachable in older versions of GFortran. --- test/prif_allocate_test.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/prif_allocate_test.F90 b/test/prif_allocate_test.F90 index 64432850..b932be6a 100644 --- a/test/prif_allocate_test.F90 +++ b/test/prif_allocate_test.F90 @@ -183,7 +183,7 @@ subroutine coarray_cleanup_simple(handle , stat, errmsg) bind(C) integer(c_int), intent(out) :: stat character(len=:), intent(out), allocatable :: errmsg - ALSO(assert_aliased(handle, ff_handle, 0)) + ALSO(assert_aliased(handle, ff_handle)) ff_count = ff_count + 1 stat = 0 @@ -194,7 +194,7 @@ subroutine coarray_cleanup_first_error(handle , stat, errmsg) bind(C) integer(c_int), intent(out) :: stat character(len=:), intent(out), allocatable :: errmsg - ALSO(assert_aliased(handle, ff_handle, 0)) + ALSO(assert_aliased(handle, ff_handle)) ff_count = ff_count + 1 errmsg = ff_err From 650bb105bfaa8459780900f858fc0efed3972674 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 13 Mar 2026 20:03:05 -0700 Subject: [PATCH 2/6] Implement prif_co_broadcast_cptr --- src/caffeine/caffeine.c | 21 +++++++++++++-------- src/caffeine/co_broadcast_s.F90 | 5 +++++ src/caffeine/prif_private_s.F90 | 10 ++++++++++ src/prif.F90 | 12 +++++++++++- 4 files changed, 39 insertions(+), 9 deletions(-) diff --git a/src/caffeine/caffeine.c b/src/caffeine/caffeine.c index a3968a1b..2f76ad35 100644 --- a/src/caffeine/caffeine.c +++ b/src/caffeine/caffeine.c @@ -548,19 +548,24 @@ void caf_co_reduce( CFI_cdesc_t* a_desc, int result_image, size_t num_elements, op_wrapper, client_data, team); } -void caf_co_broadcast(CFI_cdesc_t * a_desc, int source_image, int num_elements, gex_TM_t team) -{ - char* c_loc_a = (char*) a_desc->base_addr; - size_t c_sizeof_a = a_desc->elem_len; - int nbytes = num_elements * c_sizeof_a; - - int data_type = a_desc->type; +void caf_co_broadcast_cptr(void *a_ptr, int source_image, size_t nbytes, gex_TM_t team) { + assert(a_ptr); + assert(source_image >= 0); + assert(nbytes > 0); gex_Event_t ev - = gex_Coll_BroadcastNB(team, source_image-1, c_loc_a, c_loc_a, nbytes, 0); + = gex_Coll_BroadcastNB(team, source_image-1, a_ptr, a_ptr, nbytes, 0); gex_Event_Wait(ev); } +void caf_co_broadcast(CFI_cdesc_t * a_desc, int source_image, int num_elements, gex_TM_t team) { + assert(a_desc); + char* a_ptr = (char*) a_desc->base_addr; + size_t element_size = a_desc->elem_len; + int nbytes = num_elements * element_size; + caf_co_broadcast_cptr(a_ptr, source_image, nbytes, team); +} + //------------------------------------------------------------------- // Typed computational collective subroutines //------------------------------------------------------------------- diff --git a/src/caffeine/co_broadcast_s.F90 b/src/caffeine/co_broadcast_s.F90 index 5173a30d..a4ec6913 100644 --- a/src/caffeine/co_broadcast_s.F90 +++ b/src/caffeine/co_broadcast_s.F90 @@ -28,4 +28,9 @@ subroutine contiguous_co_broadcast(a, source_image, stat, errmsg, errmsg_alloc) ! and eliminate the calculation of num_elements*sizeof(a) in caffeine.c. end subroutine + module procedure prif_co_broadcast_cptr + 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) + end procedure end submodule co_broadcast_s diff --git a/src/caffeine/prif_private_s.F90 b/src/caffeine/prif_private_s.F90 index dd8fc4d7..be239f1a 100644 --- a/src/caffeine/prif_private_s.F90 +++ b/src/caffeine/prif_private_s.F90 @@ -301,6 +301,16 @@ subroutine caf_co_broadcast(a, source_image, Nelem, team) bind(C) type(c_ptr), value :: team end subroutine + subroutine caf_co_broadcast_cptr(a_ptr, source_image, nbytes, team) bind(C) + !! void caf_co_broadcast_cptr(void *a_ptr, int source_image, size_t nbytes, gex_TM_t team) + import c_int, c_ptr, c_size_t + implicit none + type(c_ptr), value :: a_ptr + integer(c_int), value :: source_image + integer(c_size_t), value :: nbytes + type(c_ptr), value :: team + end subroutine + subroutine caf_co_reduce(a, result_image, num_elements, op_wrapper, client_data, team) bind(C) !! void caf_co_reduce(CFI_cdesc_t* a_desc, int result_image, size_t num_elements, gex_Coll_ReduceFn_t op_wrapper, void* client_data, gex_TM_t team) import c_int, c_ptr, c_size_t, c_funptr diff --git a/src/prif.F90 b/src/prif.F90 index 4fa08065..ccdb5ff9 100644 --- a/src/prif.F90 +++ b/src/prif.F90 @@ -50,7 +50,7 @@ module prif public :: prif_num_images, prif_num_images_with_team, prif_num_images_with_team_number public :: prif_failed_images, prif_stopped_images, prif_image_status public :: prif_local_data_pointer, prif_set_context_data, prif_get_context_data, prif_size_bytes - public :: prif_co_sum, prif_co_max, prif_co_min, prif_co_reduce, prif_co_reduce_cptr, prif_co_broadcast + public :: prif_co_sum, prif_co_max, prif_co_min, prif_co_reduce, prif_co_reduce_cptr, prif_co_broadcast, prif_co_broadcast_cptr public :: prif_co_min_character, prif_co_max_character public :: prif_operation_wrapper_interface public :: prif_form_team, prif_change_team, prif_end_team, prif_get_team, prif_team_number @@ -764,6 +764,16 @@ module subroutine prif_co_broadcast(a, source_image, stat, errmsg, errmsg_alloc) character(len=:), intent(inout), allocatable, optional :: errmsg_alloc end subroutine + module subroutine prif_co_broadcast_cptr(a_ptr, size_in_bytes, source_image, stat, errmsg, errmsg_alloc) + implicit none + type(c_ptr), intent(in) :: a_ptr + integer(c_size_t), intent(in) :: size_in_bytes + integer(c_int), intent(in) :: source_image + integer(c_int), intent(out), optional :: stat + character(len=*), intent(inout), optional :: errmsg + character(len=:), intent(inout), allocatable, optional :: errmsg_alloc + end subroutine + module subroutine prif_form_team(team_number, team, new_index, stat, errmsg, errmsg_alloc) implicit none integer(c_int64_t), intent(in) :: team_number From 6b8211048db4cfa3e848018278e70d5ea6dab88f Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 13 Mar 2026 20:29:48 -0700 Subject: [PATCH 3/6] prif_co_broadcast_test: Add test coverage for prif_co_broadcast_cptr --- test/prif_co_broadcast_test.F90 | 37 ++++++++++++++++++++++++++------- 1 file changed, 30 insertions(+), 7 deletions(-) diff --git a/test/prif_co_broadcast_test.F90 b/test/prif_co_broadcast_test.F90 index 3a93da58..0c5478f7 100644 --- a/test/prif_co_broadcast_test.F90 +++ b/test/prif_co_broadcast_test.F90 @@ -1,12 +1,17 @@ +#include "test-utils.F90" + module prif_co_broadcast_test_m - use prif, only : prif_co_broadcast, prif_num_images, prif_this_image_no_coarray + use iso_c_binding, only: c_loc, c_size_t + use prif, only : prif_co_broadcast, prif_co_broadcast_cptr, prif_num_images, prif_this_image_no_coarray use julienne_m, only : & usher & + ,string_t & ,test_description_t & ,test_diagnosis_t & ,test_result_t & ,test_t & ,operator(//) & + ,operator(.also.) & ,operator(.expect.) & ,operator(.equalsExpected.) @@ -60,27 +65,45 @@ logical pure function equals(lhs, rhs) function broadcast_default_integer_scalar() result(diag) type(test_diagnosis_t) :: diag - integer iPhone, me + integer, target :: a, me integer, parameter :: source_value = 7779311, junk = -99 + diag = .true. + call prif_this_image_no_coarray(this_image=me) - iPhone = merge(source_value, junk, me==1) - call prif_co_broadcast(iPhone, source_image=1) - diag = iPhone .equalsExpected. source_value + + a = merge(source_value, junk, me==1) + call prif_co_broadcast(a, source_image=1) + ALSO(a .equalsExpected. source_value) + + a = merge(source_value*7, junk, me==1) + call prif_co_broadcast_cptr(c_loc(a), size_in_bytes=storage_size(a,c_size_t)/8, source_image=1) + ALSO(a .equalsExpected. source_value*7) end function function broadcast_derived_type() result(diag) type(test_diagnosis_t) :: diag - type(object_t) object + type(object_t), target :: object integer me, ni + diag = .true. + call prif_this_image_no_coarray(this_image=me) call prif_num_images(num_images=ni) + object = object_t(me, .false., "gooey", me*(1.,0.)) call prif_co_broadcast(object, source_image=ni) associate(expected_object => object_t(ni, .false., "gooey", ni*(1.,0.))) - diag = .expect. (object == expected_object) // "co_broadcast derived type" + ALSO2(object == expected_object, "co_broadcast derived type") + end associate + + object = object_t(me, .true., "hooey", me*(10.,0.)) + call prif_co_broadcast_cptr(c_loc(object), storage_size(object,c_size_t)/8, source_image=ni) + associate(expected_object => object_t(ni, .true., "hooey", ni*(10.,0.))) + ALSO2(object == expected_object, "co_broadcast_cptr derived type") end associate + + end function end module prif_co_broadcast_test_m From 5c66038edd962ab2f6e96b550b74c383238ecd8e Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 13 Mar 2026 20:44:26 -0700 Subject: [PATCH 4/6] Update implementation-status.md --- docs/implementation-status.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/implementation-status.md b/docs/implementation-status.md index 777d234a..47dc3a6a 100644 --- a/docs/implementation-status.md +++ b/docs/implementation-status.md @@ -188,6 +188,7 @@ selected constant values from `ISO_FORTRAN_ENV` of the hosting compiler. | Procedure | Status | Notes | |-----------|--------|-------| | `prif_co_broadcast` | **YES** | | +| `prif_co_broadcast_cptr`| **YES** | expected in PRIF 0.8 | | `prif_co_max` | **YES** | | | `prif_co_max_character` | **YES** | | | `prif_co_min` | **YES** | | From 3dde40cc58a72db8c76ecf18ebac8a27d44c3259 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Tue, 28 Apr 2026 21:39:31 -0700 Subject: [PATCH 5/6] prif_co_broadcast_test: Workaround LFortran issue 11191 https://github.com/lfortran/lfortran/issues/11191 Skip the failing test when using LFortran --- test/prif_co_broadcast_test.F90 | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/test/prif_co_broadcast_test.F90 b/test/prif_co_broadcast_test.F90 index 0c5478f7..6a2322ee 100644 --- a/test/prif_co_broadcast_test.F90 +++ b/test/prif_co_broadcast_test.F90 @@ -49,7 +49,14 @@ function results() result(test_results) allocate(test_results, source = prif_co_broadcast_test%run([ & test_description_t("broadcasting a default integer scalar with no optional arguments present", usher(broadcast_default_integer_scalar)) & - ,test_description_t("broadcasting a derived type scalar with no allocatable components", usher(broadcast_derived_type)) & + ,test_description_t("prif_co_broadcast of a derived type scalar with no allocatable components", usher(broadcast_derived_type)) & + ,test_description_t("prif_co_broadcast_cptr of a derived type scalar with no allocatable components" & +# if __LFORTRAN__ && __LFORTRAN_MAJOR__ == 0 && __LFORTRAN_MINOR__ <= 63 + ! test disabled for LFortran issue 11191 +# else + , usher(broadcast_derived_type_cptr) & +# endif + ) & ])) end function @@ -83,7 +90,7 @@ function broadcast_default_integer_scalar() result(diag) function broadcast_derived_type() result(diag) type(test_diagnosis_t) :: diag - type(object_t), target :: object + type(object_t) :: object integer me, ni diag = .true. @@ -96,14 +103,23 @@ function broadcast_derived_type() result(diag) associate(expected_object => object_t(ni, .false., "gooey", ni*(1.,0.))) ALSO2(object == expected_object, "co_broadcast derived type") end associate + end function + + function broadcast_derived_type_cptr() result(diag) + type(test_diagnosis_t) :: diag + type(object_t), target :: object + integer me, ni + + diag = .true. + + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(num_images=ni) object = object_t(me, .true., "hooey", me*(10.,0.)) call prif_co_broadcast_cptr(c_loc(object), storage_size(object,c_size_t)/8, source_image=ni) associate(expected_object => object_t(ni, .true., "hooey", ni*(10.,0.))) ALSO2(object == expected_object, "co_broadcast_cptr derived type") end associate - - end function end module prif_co_broadcast_test_m From 61121bcf2a792f7edec383e3446da68eb00b4b97 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Thu, 30 Apr 2026 19:33:11 -0700 Subject: [PATCH 6/6] prif_co_{broadcast,reduce}_test: Use sequence types where appropriate Add `sequence` to derived types used in PRIF's contiguous communication calls, to ensure a flat linear storage layout for use in communicating the raw storage sequence. --- test/prif_co_broadcast_test.F90 | 1 + test/prif_co_reduce_test.F90 | 2 ++ 2 files changed, 3 insertions(+) diff --git a/test/prif_co_broadcast_test.F90 b/test/prif_co_broadcast_test.F90 index 6a2322ee..a4541608 100644 --- a/test/prif_co_broadcast_test.F90 +++ b/test/prif_co_broadcast_test.F90 @@ -26,6 +26,7 @@ module prif_co_broadcast_test_m end type type object_t + sequence ! guarantee components reside in flat linear storage integer i logical fallacy character(len=len("fooey")) actor diff --git a/test/prif_co_reduce_test.F90 b/test/prif_co_reduce_test.F90 index 3e419c0f..322374c9 100644 --- a/test/prif_co_reduce_test.F90 +++ b/test/prif_co_reduce_test.F90 @@ -30,12 +30,14 @@ module prif_co_reduce_test_m end type type :: pair + sequence ! guarantee components reside in flat linear storage integer :: fst real :: snd end type #if HAVE_PARAM_DERIVED type :: array(length) + sequence integer, len :: length = 2 integer :: elements(length) end type