Test with Julienne

include/language-support.F90

@@ -1,6 +1,12 @@
 ! Copyright (c), The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
 
+#ifdef __GNUC__
+#  define GCC_VERSION (__GNUC__ * 10000 + __GNUC_MINOR__ * 100 + __GNUC_PATCHLEVEL__)
+#else
+#  define GCC_VERSION 0
+#endif
+
 #ifndef HAVE_SELECTED_LOGICAL_KIND
   ! Define whether the compiler supports standard intrinsic function selected_logical_kind(), 
   ! a feature introduced in Fortran 2023 clause 16.9.182.
@@ -15,9 +21,9 @@
   ! Define whether the compiler supports associating a procedure pointer dummy argument with an
   ! actual argument that is a valid target for the pointer dummy in a procedure assignment, a 
   ! feature introduced in Fortran 2008 and described in Fortran 2023 clause 15.5.2.10 paragraph 5.
-#if defined(_CRAYFTN) || defined(__INTEL_COMPILER) || defined(NAGFOR) || defined(__flang__)
-#define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 1
+#if defined _CRAYFTN  || defined __INTEL_COMPILER  || defined NAGFOR  || defined __flang__ || (GCC_VERSION > 140200)
+#  define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 1
 #else
-#define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 0
+#  define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 0
 #endif  
 #endif

manifest/fpm.toml.template

@@ -9,6 +9,7 @@ copyright = "2021-2025 The Regents of the University of California, through Lawr
 assert = {git = "https://github.com/berkeleylab/assert.git", tag = "3.0.0"}
 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"}
+julienne = {git = "https://github.com/berkeleylab/julienne.git", tag = "3.1.0"}
 
 [install]
 library = true

test/julienne-driver.F90

@@ -0,0 +1,34 @@
+! Copyright (c) 2024-2025, The Regents of the University of California and Sourcery Institute
+! Terms of use are as specified in LICENSE.txt
+
+program test_suite_driver
+  use julienne_m, only : test_fixture_t, test_harness_t
+  use prif_init_test_m, only : prif_init_test_t
+  use prif_coarray_inquiry_test_m, only :  prif_coarray_inquiry_test_t
+  use prif_co_broadcast_test_m, only : prif_co_broadcast_test_t
+  use prif_co_max_test_m, only : prif_co_max_test_t
+  use prif_co_min_test_m, only : prif_co_min_test_t
+  use prif_co_reduce_test_m, only :prif_co_reduce_test_t 
+  use prif_co_sum_test_m, only : prif_co_sum_test_t
+  use prif_image_queries_test_m, only : prif_image_queries_test_t
+  use prif_num_images_test_m, only : prif_num_images_test_t
+  use prif_sync_images_test_m, only : prif_sync_images_test_t
+  use prif_this_image_no_coarray_test_m, only : prif_this_image_no_coarray_test_t
+  implicit none
+
+  associate(test_harness => test_harness_t([ &
+     test_fixture_t( prif_init_test_t() ) &
+    ,test_fixture_t( prif_coarray_inquiry_test_t() ) &
+    ,test_fixture_t( prif_co_broadcast_test_t() ) &
+    ,test_fixture_t( prif_co_max_test_t() ) &
+    ,test_fixture_t( prif_co_min_test_t() ) &
+    ,test_fixture_t( prif_co_reduce_test_t() ) &
+    ,test_fixture_t( prif_co_sum_test_t() ) &
+    ,test_fixture_t( prif_image_queries_test_t() ) &
+    ,test_fixture_t( prif_num_images_test_t() ) &
+    ,test_fixture_t( prif_sync_images_test_t() ) &
+    ,test_fixture_t( prif_this_image_no_coarray_test_t() ) &
+  ]))
+    call test_harness%report_results
+  end associate
+end program test_suite_driver

test/main.F90

@@ -23,32 +23,9 @@ function run() result(passed)
         use caf_allocate_test, only: &
                 caf_allocate_prif_allocate => &
                     test_prif_allocate
-        use caf_co_broadcast_test, only: &
-                caf_co_broadcast_prif_co_broadcast => &
-                    test_prif_co_broadcast
-        use caf_co_max_test, only: &
-                caf_co_max_prif_co_max => &
-                    test_prif_co_max
-        use caf_co_min_test, only: &
-                caf_co_min_prif_co_min => &
-                    test_prif_co_min
-        use caf_co_reduce_test, only: &
-                caf_co_reduce_prif_co_reduce => &
-                    test_prif_co_reduce
-        use caf_co_sum_test, only: &
-                caf_co_sum_prif_co_sum => &
-                    test_prif_co_sum
-        use caf_coarray_inquiry_test, only: &
-                caf_coarray_inquiry_coarray_inquiry => &
-                    test_coarray_inquiry
         use caf_image_index_test, only: &
                 caf_image_index_prif_image_index => &
                     test_prif_image_index
-        use caf_num_images_test, only: &
-                caf_num_images_prif_num_images => &
-                    test_prif_num_images
-        use caf_image_queries_test, only: test_prif_image_queries
-        use caf_sync_images_test, only: test_prif_sync_images
         use caf_rma_test, only: &
                 caf_rma_prif_rma => &
                     test_prif_rma
@@ -61,9 +38,6 @@ function run() result(passed)
         use caf_teams_test, only: &
                 caf_teams_caf_teams => &
                     test_caf_teams
-        use caf_this_image_test, only: &
-                caf_this_image_prif_this_image_no_coarray => &
-                    test_prif_this_image_no_coarray
         use caf_stop_test, only: test_prif_stop
         use caf_error_stop_test, only: test_prif_error_stop
         use veggies, only: test_item_t, test_that, run_tests, result_t
@@ -100,22 +74,12 @@ function run() result(passed)
 #endif
         individual_tests = [a00_caffeinate_caffeinate()]
         individual_tests = [individual_tests, caf_allocate_prif_allocate()]
-        individual_tests = [individual_tests, caf_coarray_inquiry_coarray_inquiry()]
-        individual_tests = [individual_tests, caf_co_broadcast_prif_co_broadcast()]
-        individual_tests = [individual_tests, caf_co_max_prif_co_max()]
-        individual_tests = [individual_tests, caf_co_min_prif_co_min()]
-        individual_tests = [individual_tests, caf_co_reduce_prif_co_reduce()]
-        individual_tests = [individual_tests, caf_co_sum_prif_co_sum()]
         individual_tests = [individual_tests, caf_image_index_prif_image_index()]
-        individual_tests = [individual_tests, caf_num_images_prif_num_images()]
-        individual_tests = [individual_tests, test_prif_image_queries()]
         individual_tests = [individual_tests, caf_rma_prif_rma()]
         individual_tests = [individual_tests, test_prif_rma_strided()]
         individual_tests = [individual_tests, caf_teams_caf_teams()]
-        individual_tests = [individual_tests, caf_this_image_prif_this_image_no_coarray()]
         individual_tests = [individual_tests, test_prif_atomic()]
         individual_tests = [individual_tests, test_prif_event()]
-        individual_tests = [individual_tests, test_prif_sync_images()]
         individual_tests = [individual_tests, test_prif_stop()]
         individual_tests = [individual_tests, test_prif_error_stop()]
 

test/prif_co_broadcast_test.F90

@@ -1,10 +1,28 @@
-module caf_co_broadcast_test
+#include "language-support.F90"
+
+module prif_co_broadcast_test_m
   use prif, only : prif_co_broadcast, prif_num_images, prif_this_image_no_coarray
-  use veggies, only : result_t, test_item_t, describe, it, assert_equals, assert_that
+  use julienne_m, only : &
+     test_description_t &
+    ,test_diagnosis_t &
+    ,test_result_t &
+    ,test_t &
+    ,operator(//) &
+    ,operator(.expect.) &
+    ,operator(.equalsExpected.)
+#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY
+  use julienne_m, only : diagnosis_function_i
+#endif
 
   implicit none
   private
-  public :: test_prif_co_broadcast
+  public :: prif_co_broadcast_test_t
+
+  type, extends(test_t) :: prif_co_broadcast_test_t
+  contains
+    procedure, nopass, non_overridable  :: subject
+    procedure, nopass, non_overridable  :: results
+  end type
 
   type object_t
     integer i
@@ -19,16 +37,40 @@ module caf_co_broadcast_test
 
 contains
 
-  function test_prif_co_broadcast() result(tests)
-    type(test_item_t) tests
-
-    tests = describe( &
-      "The prif_co_broadcast subroutine", &
-      [ it("broadcasts a default integer scalar with no optional arguments present", broadcast_default_integer_scalar) &
-       ,it("broadcasts a derived type scalar with no allocatable components", broadcast_derived_type) &
+  pure function subject() result(test_subject)
+    character(len=:), allocatable :: test_subject
+    test_subject = "The prif_co_broadcast subroutine"
+  end function
+
+#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY
+
+  function results() result(test_results)
+    type(test_result_t), allocatable :: test_results(:)
+    type(prif_co_broadcast_test_t) prif_co_broadcast_test
+
+    test_results = prif_co_broadcast_test%run([ &
+       test_description_t("broadcasting a default integer scalar with no optional arguments present", broadcast_default_integer_scalar) &
+      ,test_description_t("broadcasting a derived type scalar with no allocatable components", broadcast_derived_type) &
     ])
   end function
 
+#else
+
+  function results() result(test_results)
+    type(test_result_t), allocatable :: test_results(:)
+    type(prif_co_broadcast_test_t) prif_co_broadcast_test
+    procedure(diagnosis_function_i), pointer :: &
+       broadcast_default_integer_scalar_ptr => broadcast_default_integer_scalar &
+      ,broadcast_derived_type_ptr => broadcast_derived_type
+
+    test_results = prif_co_broadcast_test%run([ &
+       test_description_t("broadcasting a default integer scalar with no optional arguments present", broadcast_default_integer_scalar_ptr) &
+      ,test_description_t("broadcasting a derived type scalar with no allocatable components", broadcast_derived_type_ptr) &
+    ])
+  end function
+
+#endif
+
   logical pure function equals(lhs, rhs) 
     type(object_t), intent(in) :: lhs, rhs 
     equals = all([ &
@@ -39,30 +81,29 @@ logical pure function equals(lhs, rhs)
     ])
   end function
 
-  function broadcast_default_integer_scalar() result(result_)
-    type(result_t) result_
+  function broadcast_default_integer_scalar() result(test_diagnosis)
+    type(test_diagnosis_t) test_diagnosis
     integer iPhone, me
     integer, parameter :: source_value = 7779311, junk = -99
 
     call prif_this_image_no_coarray(this_image=me)
     iPhone = merge(source_value, junk, me==1)
     call prif_co_broadcast(iPhone, source_image=1)
-    result_ = assert_equals(source_value, iPhone)
+    test_diagnosis = iPhone .equalsExpected. source_value 
   end function
 
-  function broadcast_derived_type() result(result_)
-    type(result_t) result_
+  function broadcast_derived_type() result(test_diagnosis)
+    type(test_diagnosis_t) test_diagnosis
     type(object_t) object
-    integer :: me, ni
+    integer me, ni
 
     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.)))
-      result_ = assert_that(expected_object == object, "co_broadcast derived type")
+      test_diagnosis = .expect. (object == expected_object) // "co_broadcast derived type"
     end associate
-
   end function
 
-end module caf_co_broadcast_test
+end module prif_co_broadcast_test_m