Unit test with Julienne

example/support-test/error_stop_with_character_code.f90

@@ -0,0 +1,18 @@
+program error_stop_character_code
+  use iso_c_binding, only: c_bool
+  use prif, only : prif_init, prif_error_stop, prif_stop
+  use unit_test_parameters_m, only : unexpected_error_stop, expected_error_stop, unexpected_stop
+  implicit none
+
+  integer :: init_exit_code
+
+  call prif_init(init_exit_code)
+  if (init_exit_code /= 0) call prif_error_stop(.false._c_bool, unexpected_error_stop)
+    ! prif_error_stop_test.f90 should report a test failure if the above line invoikes prif_error_stop
+
+  call prif_error_stop(.false._c_bool, " ")
+    ! prif_error_stop_test.f90 should report a passing test if the above prif_error_stop call succeeds 
+
+  call prif_stop(.false._c_bool, unexpected_stop)
+    ! prif_error_stop_test.f90 should report a passing test if the above prif_stop call executes
+end program

example/support-test/error_stop_with_integer_code.f90

@@ -0,0 +1,18 @@
+program error_stop_with_integer_code
+  use iso_c_binding, only: c_bool
+  use prif, only : prif_init, prif_error_stop, prif_stop
+  use unit_test_parameters_m, only : unexpected_error_stop, expected_error_stop, unexpected_stop
+  implicit none
+
+  integer :: init_exit_code
+
+  call prif_init(init_exit_code)
+  if (init_exit_code /= 0) call prif_error_stop(.false._c_bool, unexpected_error_stop)
+    ! prif_error_stop_test.f90 should report a test failure if the above line invoikes prif_error_stop
+
+  call prif_error_stop(.false._c_bool, expected_error_stop)
+    ! prif_error_stop_test.f90 should report a passing test if the above prif_error_stop call succeeds 
+
+  call prif_stop(.false._c_bool, unexpected_stop)
+    ! prif_error_stop_test.f90 should report a passing test if the above prif_stop call executes
+end program

example/support-test/stop_with_integer_code.f90

@@ -1,14 +1,18 @@
-program stop_with_no_code
+program stop_with_integer_code
   use iso_c_binding, only: c_bool
-  use prif, only : prif_init, prif_stop
+  use prif, only : prif_init, prif_error_stop, prif_stop
+  use unit_test_parameters_m, only : unexpected_error_stop, expected_stop, unexpected_stop
   implicit none
 
   integer :: init_exit_code
 
   call prif_init(init_exit_code)
-  if (init_exit_code /= 0) error stop "caffeinate returned a non-zero exit_code"
+  if (init_exit_code /= 0) call prif_error_stop(.false._c_bool, unexpected_error_stop)
+    ! prif_stop_test.f90 should report a test failure if the above line invoikes prif_error_stop
 
-  call prif_stop(.false._c_bool, 1)
+  call prif_stop(.false._c_bool, expected_stop)
+    ! prif_stop_test.f90 should report a passing test if the above prif_error_stop call succeeds 
 
-  stop 2 ! caffeine/test/zzz_finalization_test.f90 reports a failure if this line runs
-end program 
+  call prif_stop(.false._c_bool, unexpected_stop)
+    ! prif_stop_test.f90 should report a test failure if the above prif_stop call executes
+end program

include/language-support.F90

@@ -0,0 +1,23 @@
+! Copyright (c), The Regents of the University of California
+! Terms of use are as specified in LICENSE.txt
+
+#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.
+#if defined(_CRAYFTN) || defined(NAGFOR) || defined(__flang__)
+#define HAVE_SELECTED_LOGICAL_KIND 1
+#else
+#define HAVE_SELECTED_LOGICAL_KIND 0
+#endif  
+#endif
+
+#ifndef HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY
+  ! 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
+#else
+#define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 0
+#endif  
+#endif

install.sh

@@ -356,12 +356,21 @@ EOF
 
 exit_if_pkg_config_pc_file_missing "caffeine"
 
+compiler_version=$($FPM_FC --version)
+if [[ $compiler_version == *llvm* ]]; then
+  compiler_flag="-mmlir -allow-assumed-rank -g -Ofast"
+else
+  compiler_flag="-g -O3"
+fi
+
 RUN_FPM_SH="build/run-fpm.sh"
 cat << EOF > $RUN_FPM_SH
 #!/bin/sh
 #-- DO NOT EDIT -- created by caffeine/install.sh
 fpm_sub_cmd=\$1; shift
 "${FPM}" "\$fpm_sub_cmd" \\
+--profile debug \\
+--flag "$compiler_flag" \\
 --compiler "`$PKG_CONFIG caffeine --variable=CAFFEINE_FPM_FC`"   \\
 --c-compiler "`$PKG_CONFIG caffeine --variable=CAFFEINE_FPM_CC`" \\
 --c-flag "`$PKG_CONFIG caffeine --variable=CAFFEINE_FPM_CFLAGS`" \\

manifest/fpm.toml.template

@@ -6,7 +6,6 @@ maintainer = "rouson@lbl.gov"
 copyright = "2021-2024 UC Regents"
 
 [dev-dependencies]
-veggies = {git = "https://gitlab.com/everythingfunctional/veggies", tag = "v1.1.2"}
-iso_varying_string = {git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v3.0.4"}
+julienne = {git = "https://github.com/berkeleylab/julienne", tag = "1.3.0"}
 
 [build]

src/caffeine/collective_subroutines/co_reduce_s.f90

@@ -259,28 +259,26 @@ subroutine Coll_ReduceSub_c_char(arg1, arg2_and_out, count, cdata) bind(C)
       integer(c_size_t), value :: count  !! Operand count
       type(c_ptr), value ::  cdata       !! Client data
 
-      character(kind=c_char, len=:), allocatable, target :: prototype(:)
-      character(kind=c_char, len=:), pointer :: lhs(:)=>null(), rhs_and_result(:)=>null()
       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)")
       end associate
 
       call c_f_pointer(cdata, arglen)
-      allocate(character(kind=c_char, len=arglen) :: prototype(count))
-      lhs => prototype ! set string length
-      rhs_and_result => prototype ! set string length
+      block
+        character(kind=c_char, len=arglen), pointer :: lhs(:)=>null(), rhs_and_result(:)=>null()
 
-      call c_f_pointer(arg1, lhs, [count])
-      call c_f_pointer(arg2_and_out, rhs_and_result, [count])
+        call c_f_pointer(arg1, lhs, [count])
+        call c_f_pointer(arg2_and_out, rhs_and_result, [count])
 
-      block
-        integer(c_size_t) i
+        block
+          integer(c_size_t) i
 
-        do i=1, count
-          rhs_and_result(i) = char_op(lhs(i), rhs_and_result(i))
-        end do
+          do i=1, count
+            rhs_and_result(i) = char_op(lhs(i), rhs_and_result(i))
+          end do
+        end block
       end block
 
     end subroutine

src/caffeine/program_termination_s.f90

@@ -24,7 +24,7 @@ subroutine prif_stop_integer(stop_code)
       !! synchronize, stop the executing image, and provide the stop_code, or 0 if not present, as the process exit status
       integer, intent(in), optional :: stop_code
 
-      sync all
+      call prif_sync_all()
 
       !write(output_unit, *) "caf_stop: stop code '", stop_code, "'"
       write(output_unit, *) stop_code
@@ -39,7 +39,7 @@ subroutine prif_stop_character(stop_code)
       !! synchronize, stop the executing image, and provide the stop_code as the process exit status
       character(len=*), intent(in) :: stop_code
 
-      sync all
+      call prif_sync_all()
 
       write(output_unit, *) "caf_stop: stop code '" // stop_code // "'"
       flush output_unit
@@ -145,7 +145,7 @@ pure function c_f_string(c_string, length) result(f_string)
     character(len=length) :: f_string
 
     integer :: i
-    do concurrent (i = 1:length)
+    do i = 1,length
       f_string(i:i) = c_string(i)
     end do
   end function

src/caffeine/unit_test_parameters_m.f90

@@ -0,0 +1,12 @@
+! Copyright (c), The Regents of the University of California
+! Terms of use are as specified in LICENSE.txt
+
+module unit_test_parameters_m
+  !! Define values for use in the test suite, including example
+  !! programs that the test suite builds and runs.
+  implicit none
+
+  enum, bind(C)
+    enumerator :: expected_error_stop=99, unexpected_error_stop, expected_stop, unexpected_stop
+  end enum
+end module

src/prif.f90 → src/prif.F90

@@ -1,5 +1,8 @@
 ! Copyright (c), The Regents of the University of California
 ! Terms of use are as specified in LICENSE.txt
+
+#include "language-support.F90"
+
 module prif
 
   use iso_c_binding, only: c_int, c_bool, c_intptr_t, c_intmax_t, c_ptr, c_funptr, c_size_t, c_ptrdiff_t, c_null_ptr
@@ -42,11 +45,12 @@ module prif
   integer(c_int), parameter, public :: PRIF_VERSION_MINOR = 4
 
   integer(c_int), parameter, public :: PRIF_ATOMIC_INT_KIND = selected_int_kind(18)
-  ! gfortran-14 doesn't currently support the intrinsic selected_logical_kind
-  ! The following commented-out definition is the desired definition and should replace
-  ! the temporary definition when possible
-  ! integer(c_int), parameter, public :: PRIF_ATOMIC_LOGICAL_KIND = selected_logical_kind(32)
+
+#if HAVE_SELECTED_LOGICAL_KIND
+  integer(c_int), parameter, public :: PRIF_ATOMIC_LOGICAL_KIND = selected_logical_kind(32)
+#else
   integer(c_int), parameter, public :: PRIF_ATOMIC_LOGICAL_KIND = PRIF_ATOMIC_INT_KIND
+#endif
 
   integer(c_int), parameter, public :: &
     PRIF_CURRENT_TEAM               = 101, &

test/main.F90

@@ -0,0 +1,106 @@
+! Copyright (c) 2024, The Regents of the University of California and Sourcery Institute
+! Terms of use are as specified in LICENSE.txt
+
+program main
+  !! Test the Caffeine implementation of the Parallel Runtime Interface for Fortran (PRIF)
+  use julienne_m, only : command_line_t, GitHub_CI
+  use prif, only : &
+    prif_this_image_no_coarray &
+   ,prif_sync_all &
+   ,prif_error_stop &
+   ,prif_stop
+  use prif_allocate_test_m, only : prif_allocate_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_error_stop_test_m, only : prif_error_stop_test_t
+  use prif_image_index_test_m, only : prif_image_index_test_t
+  use prif_init_test_m, only : prif_init_test_t
+  use prif_num_images_test_m, only : prif_num_images_test_t
+  use prif_rma_test_m, only : prif_rma_test_t
+  use prif_stop_test_m, only : prif_stop_test_t
+  use prif_teams_test_m, only : prif_teams_test_t
+  use prif_this_image_test_m, only : prif_this_image_test_t
+  implicit none
+
+  integer :: passes=0, tests=0
+  integer me
+
+  call stop_and_print_usage_info_if_help_requested
+  call run_tests_and_report(passes, tests)
+  call prif_this_image_no_coarray(this_image=me)
+
+  if (me==1) print *, new_line(''), "_________ In total, ",passes," of ",tests, " tests pass. _________"
+  call prif_sync_all
+  if (passes /= tests) call prif_error_stop(quiet=.false.) ! PRIF sec 5.2 requires the client to 
+  !call prif_stop(quiet=.true.)                             ! eventually call prif_error_stop or prif_stop
+
+contains
+
+  subroutine stop_and_print_usage_info_if_help_requested
+    type(command_line_t) command_line
+
+    character(len=*), parameter :: usage = &
+      new_line('') // new_line('') // &
+      'Usage: fpm test -- [--help] | [--contains <substring>]' // &
+      new_line('') // new_line('') // &
+      'where square brackets ([]) denote optional arguments, a pipe (|) separates alternative arguments,' // new_line('') // &
+      'angular brackets (<>) denote a user-provided value, and passing a substring limits execution to' // new_line('') // &
+      'the tests with test subjects or test descriptions containing the user-specified substring.' // new_line('') 
+
+    if (command_line%argument_present([character(len=len("--help"))::"--help","-h"])) stop usage
+
+  end subroutine
+
+  subroutine run_tests_and_report(passes, tests)
+    integer, intent(inout) :: passes, tests
+
+    type(prif_allocate_test_t) prif_allocate_test
+    type(prif_co_broadcast_test_t) prif_co_broadcast_test
+    type(prif_co_max_test_t) prif_co_max_test
+    type(prif_co_min_test_t) prif_co_min_test
+    type(prif_co_reduce_test_t) prif_co_reduce_test
+    type(prif_co_sum_test_t) prif_co_sum_test
+    type(prif_error_stop_test_t) prif_error_stop_test
+    type(prif_image_index_test_t) prif_image_index_test
+    type(prif_init_test_t) prif_init_test
+    type(prif_num_images_test_t) prif_num_images_test
+    type(prif_rma_test_t) prif_rma_test
+    type(prif_stop_test_t) prif_stop_test
+    type(prif_teams_test_t) prif_teams_test
+    type(prif_this_image_test_t) prif_this_image_test
+
+    call prif_init_test%report(passes, tests)
+    call prif_allocate_test%report(passes, tests)
+    call prif_num_images_test%report(passes, tests)
+    call prif_this_image_test%report(passes, tests)
+    call prif_co_broadcast_test%report(passes, tests)
+    call prif_teams_test%report(passes, tests)
+    call prif_stop_test%report(passes, tests)
+#ifdef __flang__
+    print *
+    print *,"!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
+    print *
+    print *,"LLVM Flang detected. Skipping tests that crash:"
+    print *,"  - prif_co_max_test"
+    print *,"  - prif_co_min_test"
+    print *,"  - prif_co_reduce_test"
+    print *,"  - prif_co_sum_test"
+    print *,"  - prif_image_index_test"
+    print *
+    print *,"!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
+#else
+    call prif_image_index_test%report(passes, tests)
+    call prif_error_stop_test%report(passes, tests)
+    call prif_co_max_test%report(passes, tests)
+    call prif_co_min_test%report(passes, tests)
+    call prif_co_reduce_test%report(passes, tests)
+    call prif_co_sum_test%report(passes, tests)
+    call prif_rma_test%report(passes, tests)
+#endif
+
+  end subroutine run_tests_and_report
+
+end program