From 3f2de6cf500db6d76a37a87477d6c1b75b99e37b Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 28 Aug 2025 18:20:15 -0700 Subject: [PATCH 01/13] build(fpm.toml.template): update to Julienne 3.3.0 --- manifest/fpm.toml.template | 1 + 1 file changed, 1 insertion(+) diff --git a/manifest/fpm.toml.template b/manifest/fpm.toml.template index 394c3726..dca00f2e 100644 --- a/manifest/fpm.toml.template +++ b/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.2.1"} 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.3.0"} [install] library = true From 4cf8686c4e588a73ea453e1a714433fbf61c9a26 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 23 Aug 2025 23:12:54 -0700 Subject: [PATCH 02/13] test(julienne): add driver & tests This commit adds a test-suite driver, test/julienne/driver.f90, with supporting tests for the following subroutines: - prif_co_broadcast - prif_co_min - prif_co_max - prif_image_queries - prif_init - prif_num_images - prif_this_image_no_coarray - prif_sync_images All new tests are in test/julienne. All tests pass. TODO: restrict output to image 1 chore: rm redundant tests This commit removes veggies tests for the following subroutines because they are now redundant with the correspondiong julienne tests added in a prior commit: - prif_co_broadcast - prif_co_max - prif_co_min - prif_image_queries - prif_num_images - prif_sync_images - prif_this_image This commit retains the redundant prif_init test becuase it is presumalby needed for the proper launch of the veggies tests. build(fpm.toml.template): add Julienne 3.0.0 dep test(co_sum): add julienne test, rm veggies test test(co_reduce): add julienne test|rm veggies test chore: non_overridable test_t child type-bnd-procs fix(image_queries_test): add closing parens test: add prif_coarray_inquiry_test_m fix: rm binary chore: rm veggies prif_coarray_inquiry_test fix(test/julienne): support GCC 13 - 14.2 chore: rm reference to deleted veggies test chore: rm partially complete julienne test build(include): fix macro logic/syntax test(julienne): append to diagnostics strings This commit appends the text from veggies assertions "message" argument to test diagnoses in the corresponding Julienne tests. For example, a veggies assertion of the form assert_equals(actual, expected, message) becomes a Julienne test diagnosis of the following form: (actual .equalsExpected. expected) // message Remove inadvertently added GASNet install trees Remove some stray programs Rename file to match Caffiene source file naming conventions (See docs/README-maintainers.md) test(julienne): fix GCC 13-14.2 workaround Rename test files back to their original location, for ease of PR review and maintenance There are zero code changes in this commit doc(julienne): switch to Caffeine's copyright Co-authored-by: Dan Bonachea --- include/language-support.F90 | 12 +- test/julienne-driver.F90 | 34 +++ test/main.F90 | 36 --- test/prif_co_broadcast_test.F90 | 79 ++++-- test/prif_co_max_test.F90 | 149 ++++++++---- test/prif_co_min_test.F90 | 344 +++++++++++++++----------- test/prif_co_reduce_test.F90 | 103 ++++++-- test/prif_co_sum_test.F90 | 377 +++++++++++++++++------------ test/prif_coarray_inquiry_test.F90 | 280 +++++++++++---------- test/prif_image_queries_test.F90 | 156 ++++++++---- test/prif_init_test.F90 | 86 +++++++ test/prif_num_images_test.F90 | 67 +++-- test/prif_sync_images_test.F90 | 88 +++++-- test/prif_this_image_test.F90 | 98 +++++--- 14 files changed, 1229 insertions(+), 680 deletions(-) create mode 100644 test/julienne-driver.F90 create mode 100644 test/prif_init_test.F90 diff --git a/include/language-support.F90 b/include/language-support.F90 index 5130650b..37221610 100644 --- a/include/language-support.F90 +++ b/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,10 +21,10 @@ ! 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 diff --git a/test/julienne-driver.F90 b/test/julienne-driver.F90 new file mode 100644 index 00000000..77155194 --- /dev/null +++ b/test/julienne-driver.F90 @@ -0,0 +1,34 @@ +! Copyright (c) 2024-2025, The Regents of the University of California +! 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 diff --git a/test/main.F90 b/test/main.F90 index dbbaf8f2..425fb2ea 100644 --- a/test/main.F90 +++ b/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()] diff --git a/test/prif_co_broadcast_test.F90 b/test/prif_co_broadcast_test.F90 index d7e6f793..092a4745 100644 --- a/test/prif_co_broadcast_test.F90 +++ b/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 diff --git a/test/prif_co_max_test.F90 b/test/prif_co_max_test.F90 index 5305b037..6ca0d8d6 100644 --- a/test/prif_co_max_test.F90 +++ b/test/prif_co_max_test.F90 @@ -1,31 +1,87 @@ -module caf_co_max_test - use iso_c_binding, only: c_int8_t, c_int16_t, c_int32_t, c_int64_t, c_float, c_double - use prif, only : prif_co_max, prif_co_max_character, prif_this_image_no_coarray, prif_num_images - use veggies, only: result_t, test_item_t, assert_equals, describe, it, succeed - +#include "language-support.F90" + +module prif_co_max_test_m + use iso_c_binding, only: c_int8_t, c_int16_t, c_int32_t, c_int64_t, c_float, c_double + use prif, only : prif_co_max, prif_co_max_character, prif_this_image_no_coarray, prif_num_images + use julienne_m, only: & + operator(.all.) & + ,operator(.approximates.) & + ,operator(.within.) & + ,operator(.equalsExpected.) & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t +#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + use julienne_m, only : diagnosis_function_i +#endif implicit none + + private - public :: test_prif_co_max + public :: prif_co_max_test_t + + type, extends(test_t) :: prif_co_max_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type contains - function test_prif_co_max() result(tests) - type(test_item_t) tests - - tests = describe( & - "The prif_co_max subroutine computes the maximum value across images for corresponding elements for", & - [ it("a 1D default integer array", check_default_integer) & - , it("a 1D 8-bit integer array", check_8_bit_integer) & - , it("a 1D 16-bit integer array", check_16_bit_integer) & - , it("32-bit integer scalars", check_32_bit_integer) & - , it("a 1D 64-bit integer array", check_64_bit_integer) & - , it("a 2D 32-bit real array", check_32_bit_real) & - , it("a 1D 64-bit real array", check_64_bit_real) & - , it("a character scalar", check_character) & - ]) + + pure function subject() result(test_subject) + character(len=:), allocatable :: test_subject + test_subject = "The prif_co_max 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_max_test_t) prif_co_max_test + + test_results = prif_co_max_test%run([ & + test_description_t("computing element-wise maxima for integer(c_int32_t) scalars", check_32_bit_integer) & + ,test_description_t("computing element-wise maxima for a 1D default integer array", check_default_integer) & + ,test_description_t("computing element-wise maxima for a 1D integer(c_int8_t) array", check_8_bit_integer) & + ,test_description_t("computing element-wise maxima for a 1D integer(c_int16_t) array", check_16_bit_integer) & + ,test_description_t("computing element-wise maxima for a 1D integer(c_int64_t array", check_64_bit_integer) & + ,test_description_t("computing element-wise maxima for a 2D real(c_float) array", check_32_bit_real) & + ,test_description_t("computing element-wise maxima for a 1D real(c_double array", check_64_bit_real) & + ,test_description_t("computing element-wise maxima for character scalars", check_character) & + ]) + end function + +#else + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_co_max_test_t) prif_co_max_test + procedure(diagnosis_function_i), pointer :: & + check_32_bit_integer_ptr => check_32_bit_integer & + ,check_default_integer_ptr => check_default_integer & + ,check_8_bit_integer_ptr => check_8_bit_integer & + ,check_16_bit_integer_ptr => check_16_bit_integer & + ,check_64_bit_integer_ptr => check_64_bit_integer & + ,check_32_bit_real_ptr => check_32_bit_real & + ,check_64_bit_real_ptr => check_64_bit_real & + ,check_character_ptr => check_character + + test_results = prif_co_max_test%run([ & + test_description_t("computing element-wise maxima for integer(c_int32_t) scalars", check_32_bit_integer_ptr) & + ,test_description_t("computing element-wise maxima for a 1D default integer array", check_default_integer_ptr) & + ,test_description_t("computing element-wise maxima for a 1D integer(c_int8_t) array", check_8_bit_integer_ptr) & + ,test_description_t("computing element-wise maxima for a 1D integer(c_int16_t) array", check_16_bit_integer_ptr) & + ,test_description_t("computing element-wise maxima for a 1D integer(c_int64_t array", check_64_bit_integer_ptr) & + ,test_description_t("computing element-wise maxima for a 2D real(c_float) array", check_32_bit_real_ptr) & + ,test_description_t("computing element-wise maxima for a 1D real(c_double array", check_64_bit_real_ptr) & + ,test_description_t("computing element-wise maxima for character scalars", check_character_ptr) & + ]) end function - function check_default_integer() result(result_) - type(result_t) :: result_ +#endif + function check_default_integer() result(test_diagnosis) + type(test_diagnosis_t) :: test_diagnosis integer, parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) integer :: me, ni, i @@ -38,11 +94,11 @@ function check_default_integer() result(result_) call prif_co_max(my_val) expected = maxval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(int(expected), int(my_val)) + test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_8_bit_integer() result(result_) - type(result_t) :: result_ + function check_8_bit_integer() result(test_diagnosis) + type(test_diagnosis_t) :: test_diagnosis integer(c_int8_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int8_t), [2, 4]) integer :: me, ni, i @@ -55,11 +111,11 @@ function check_8_bit_integer() result(result_) call prif_co_max(my_val) expected = maxval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(int(expected), int(my_val)) + test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_16_bit_integer() result(result_) - type(result_t) :: result_ + function check_16_bit_integer() result(test_diagnosis) + type(test_diagnosis_t) :: test_diagnosis integer(c_int16_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int16_t), [2, 4]) integer :: me, ni, i @@ -72,11 +128,11 @@ function check_16_bit_integer() result(result_) call prif_co_max(my_val) expected = maxval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(int(expected), int(my_val)) + test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_32_bit_integer() result(result_) - type(result_t) :: result_ + function check_32_bit_integer() result(test_diagnosis) + type(test_diagnosis_t) :: test_diagnosis integer(c_int32_t), parameter :: values(*) = [1, -19, 5, 13, 11, 7, 17, 3] integer :: me, ni, i @@ -89,11 +145,11 @@ function check_32_bit_integer() result(result_) call prif_co_max(my_val) expected = maxval([(values(mod(i-1,size(values))+1), i = 1, ni)]) - result_ = assert_equals(expected, my_val) + test_diagnosis = my_val .equalsExpected. expected end function - function check_64_bit_integer() result(result_) - type(result_t) :: result_ + function check_64_bit_integer() result(test_diagnosis) + type(test_diagnosis_t) :: test_diagnosis integer(c_int64_t), parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) integer :: me, ni, i @@ -106,13 +162,14 @@ function check_64_bit_integer() result(result_) call prif_co_max(my_val) expected = maxval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(int(expected), int(my_val)) + test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_32_bit_real() result(result_) - type(result_t) :: result_ + function check_32_bit_real() result(test_diagnosis) + type(test_diagnosis_t) :: test_diagnosis real(c_float), parameter :: values(*,*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2,2,2]) + real(c_float), parameter :: tolerance = 0_c_float integer :: me, ni, i real(c_float), dimension(size(values,1), size(values,2)) :: my_val, expected @@ -123,13 +180,14 @@ function check_32_bit_real() result(result_) call prif_co_max(my_val) expected = maxval(reshape([(values(:,:,mod(i-1,size(values,3))+1), i = 1, ni)], [size(values,1), size(values,2), ni]), dim=3) - result_ = assert_equals(real(expected,kind=c_double), real(my_val,kind=c_double)) + test_diagnosis = .all. (my_val .approximates. expected .within. tolerance) end function - function check_64_bit_real() result(result_) - type(result_t) :: result_ + function check_64_bit_real() result(test_diagnosis) + type(test_diagnosis_t) :: test_diagnosis real(c_double), parameter :: values(*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2, 4]) + real(c_double), parameter :: tolerance = 0_c_double integer :: me, ni, i real(c_double), dimension(size(values,1)) :: my_val, expected @@ -140,11 +198,11 @@ function check_64_bit_real() result(result_) call prif_co_max(my_val) expected = maxval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(expected, my_val) + test_diagnosis = .all. (my_val .approximates. expected .within. tolerance) end function - function check_character() result(result_) - type(result_t) result_ + function check_character() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis character(len=*), parameter :: values(*) = & [ "To be ","or not " & , "to ","be. " & @@ -161,9 +219,8 @@ function check_character() result(result_) ! issue #205: workaround flang optimizer bug with a temp associate(tmp => [(values(mod(i-1,size(values))+1), i = 1, ni)]) - expected = maxval(tmp) + test_diagnosis = my_val .equalsExpected. maxval(tmp) end associate - result_ = assert_equals(expected, my_val) end function -end module caf_co_max_test +end module prif_co_max_test_m diff --git a/test/prif_co_min_test.F90 b/test/prif_co_min_test.F90 index 2a85a2bc..fe4e7740 100644 --- a/test/prif_co_min_test.F90 +++ b/test/prif_co_min_test.F90 @@ -1,169 +1,225 @@ -module caf_co_min_test - use iso_c_binding, only: c_int8_t, c_int16_t, c_int32_t, c_int64_t, c_float, c_double - use prif, only : prif_co_min, prif_co_min_character, prif_this_image_no_coarray, prif_num_images - use veggies, only: result_t, test_item_t, assert_equals, describe, it, succeed - - implicit none - private - public :: test_prif_co_min +#include "language-support.F90" + +module prif_co_min_test_m + use iso_c_binding, only: c_int8_t, c_int16_t, c_int32_t, c_int64_t, c_float, c_double + use prif, only : prif_co_min, prif_co_min_character, prif_this_image_no_coarray, prif_num_images + use julienne_m, only: & + operator(.all.) & + ,operator(.approximates.) & + ,operator(.within.) & + ,operator(.equalsExpected.) & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t +#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + use julienne_m, only : diagnosis_function_i +#endif + implicit none + + private + public :: prif_co_min_test_t + + type, extends(test_t) :: prif_co_min_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type contains - function test_prif_co_min() result(tests) - type(test_item_t) tests - - tests = describe( & - "The prif_co_min subroutine computes the minimum value across images for corresponding elements for", & - [ it("a 1D default integer array", check_default_integer) & - , it("a 1D 8-bit integer array", check_8_bit_integer) & - , it("a 1D 16-bit integer array", check_16_bit_integer) & - , it("32-bit integer scalars", check_32_bit_integer) & - , it("a 1D 64-bit integer array", check_64_bit_integer) & - , it("a 2D 32-bit real array", check_32_bit_real) & - , it("a 1D 64-bit real array", check_64_bit_real) & - , it("a character scalar", check_character) & - ]) - end function - - function check_default_integer() result(result_) - type(result_t) :: result_ - - integer, parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) - integer :: me, ni, i - integer, dimension(size(values,1)) :: my_val, expected - - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) - - my_val = values(:, mod(me-1, size(values,2))+1) - call prif_co_min(my_val) - - expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(int(expected), int(my_val)) - end function - - function check_8_bit_integer() result(result_) - type(result_t) :: result_ - - integer(c_int8_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int8_t), [2, 4]) - integer :: me, ni, i - integer(c_int8_t), dimension(size(values,1)) :: my_val, expected - - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) - - my_val = values(:, mod(me-1, size(values,2))+1) - call prif_co_min(my_val) - - expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(int(expected), int(my_val)) - end function - - function check_16_bit_integer() result(result_) - type(result_t) :: result_ - - integer(c_int16_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int16_t), [2, 4]) - integer :: me, ni, i - integer(c_int16_t), dimension(size(values,1)) :: my_val, expected - - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) - - my_val = values(:, mod(me-1, size(values,2))+1) - call prif_co_min(my_val) - - expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(int(expected), int(my_val)) - end function - - function check_32_bit_integer() result(result_) - type(result_t) :: result_ - - integer(c_int32_t), parameter :: values(*) = [1, -19, 5, 13, 11, 7, 17, 3] - integer :: me, ni, i - integer(c_int32_t) :: my_val, expected + pure function subject() result(test_subject) + character(len=:), allocatable :: test_subject + test_subject = "The prif_co_min 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_min_test_t) prif_co_min_test + + test_results = prif_co_min_test%run([ & + test_description_t("computing element-wise minima for integer(c_int32_t) scalars", check_32_bit_integer) & + ,test_description_t("computing element-wise minima for a 1D default integer array", check_default_integer) & + ,test_description_t("computing element-wise minima for a 1D integer(c_int8t) array", check_8_bit_integer) & + ,test_description_t("computing element-wise minima for a 1D integer(c_int16_t) array", check_16_bit_integer) & + ,test_description_t("computing element-wise minima for a 1D integer(c_int64_t) array", check_64_bit_integer) & + ,test_description_t("computing element-wise minima for a 2D real(c_float) array", check_32_bit_real) & + ,test_description_t("computing element-wise minima for a 1D real(c_double) array", check_64_bit_real) & + ,test_description_t("computing element-wise minima for a character scalar", check_character) & + ]) + end function + +#else + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_co_min_test_t) prif_co_min_test + procedure(diagnosis_function_i), pointer :: & + check_32_bit_integer_ptr => check_32_bit_integer & + ,check_default_integer_ptr => check_default_integer & + ,check_8_bit_integer_ptr => check_8_bit_integer & + ,check_16_bit_integer_ptr => check_16_bit_integer & + ,check_64_bit_integer_ptr => check_64_bit_integer & + ,check_32_bit_real_ptr => check_32_bit_real & + ,check_64_bit_real_ptr => check_64_bit_real & + ,check_character_ptr => check_character + + test_results = prif_co_min_test%run([ & + test_description_t("computing element-wise minima for integer(c_int32_t) scalars", check_32_bit_integer_ptr) & + ,test_description_t("computing element-wise minima for a 1D default integer array", check_default_integer_ptr) & + ,test_description_t("computing element-wise minima for a 1D integer(c_int8t) array", check_8_bit_integer_ptr) & + ,test_description_t("computing element-wise minima for a 1D integer(c_int16_t) array", check_16_bit_integer_ptr) & + ,test_description_t("computing element-wise minima for a 1D integer(c_int64_t) array", check_64_bit_integer_ptr) & + ,test_description_t("computing element-wise minima for a 2D real(c_float) array", check_32_bit_real_ptr) & + ,test_description_t("computing element-wise minima for a 1D real(c_double) array", check_64_bit_real_ptr) & + ,test_description_t("computing element-wise minima for a character scalar", check_character_ptr) & + ]) + end function + +#endif + + function check_default_integer() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) + integer, parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) + integer, dimension(size(values,1)) :: my_val, expected + integer me, ni, i - my_val = values(mod(me-1, size(values))+1) - call prif_co_min(my_val) + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) + + my_val = values(:, mod(me-1, size(values,2))+1) + call prif_co_min(my_val) + + expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) + test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + end function - expected = minval([(values(mod(i-1,size(values))+1), i = 1, ni)]) - result_ = assert_equals(expected, my_val) - end function + function check_8_bit_integer() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + + integer(c_int8_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int8_t), [2, 4]) + integer :: me, ni, i + integer(c_int8_t), dimension(size(values,1)) :: my_val, expected + + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) + + my_val = values(:, mod(me-1, size(values,2))+1) + call prif_co_min(my_val) + + expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) + test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + end function + + function check_16_bit_integer() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + + integer(c_int16_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int16_t), [2, 4]) + integer :: me, ni, i + integer(c_int16_t), dimension(size(values,1)) :: my_val, expected + + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) + + my_val = values(:, mod(me-1, size(values,2))+1) + call prif_co_min(my_val) + + expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) + test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + end function + + function check_32_bit_integer() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + + integer(c_int32_t), parameter :: values(*) = [1, -19, 5, 13, 11, 7, 17, 3] + integer :: me, ni, i + integer(c_int32_t) :: my_val, expected + + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) + + my_val = values(mod(me-1, size(values))+1) + call prif_co_min(my_val) + + expected = minval([(values(mod(i-1,size(values))+1), i = 1, ni)]) + test_diagnosis = int(my_val) .equalsExpected. int(expected) + end function - function check_64_bit_integer() result(result_) - type(result_t) :: result_ + function check_64_bit_integer() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis - integer(c_int64_t), parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) - integer :: me, ni, i - integer(c_int64_t), dimension(size(values,1)) :: my_val, expected + integer(c_int64_t), parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) + integer :: me, ni, i + integer(c_int64_t), dimension(size(values,1)) :: my_val, expected - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) - my_val = values(:, mod(me-1, size(values,2))+1) - call prif_co_min(my_val) + my_val = values(:, mod(me-1, size(values,2))+1) + call prif_co_min(my_val) - expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(int(expected), int(my_val)) - end function + expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) + test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + end function - function check_32_bit_real() result(result_) - type(result_t) :: result_ + function check_32_bit_real() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis - real(c_float), parameter :: values(*,*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2,2,2]) - integer :: me, ni, i - real(c_float), dimension(size(values,1), size(values,2)) :: my_val, expected + real(c_float), parameter :: values(*,*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2,2,2]) + real(c_double), parameter :: tolerance = 0_c_double + integer :: me, ni, i + real(c_float), dimension(size(values,1), size(values,2)) :: my_val, expected - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) - my_val = values(:, :, mod(me-1, size(values,3))+1) - call prif_co_min(my_val) + my_val = values(:, :, mod(me-1, size(values,3))+1) + call prif_co_min(my_val) - expected = minval(reshape([(values(:,:,mod(i-1,size(values,3))+1), i = 1, ni)], [size(values,1), size(values,2), ni]), dim=3) - result_ = assert_equals(real(expected,kind=c_double), real(my_val,kind=c_double)) - end function + expected = minval(reshape([(values(:,:,mod(i-1,size(values,3))+1), i = 1, ni)], [size(values,1), size(values,2), ni]), dim=3) + test_diagnosis = .all. (real(expected,kind=c_double) .approximates. real(my_val,kind=c_double) .within. tolerance) + end function - function check_64_bit_real() result(result_) - type(result_t) :: result_ + function check_64_bit_real() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis - real(c_double), parameter :: values(*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2, 4]) - integer :: me, ni, i - real(c_double), dimension(size(values,1)) :: my_val, expected + real(c_double), parameter :: values(*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2, 4]) + real(c_double), parameter :: tolerance = 0_c_double + integer :: me, ni, i + real(c_double), dimension(size(values,1)) :: my_val, expected - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) - my_val = values(:, mod(me-1, size(values,2))+1) - call prif_co_min(my_val) + my_val = values(:, mod(me-1, size(values,2))+1) + call prif_co_min(my_val) - expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(expected, my_val) - end function + expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) + test_diagnosis = .all. (my_val .approximates. expected .within. tolerance) + end function - function check_character() result(result_) - type(result_t) result_ - character(len=*), parameter :: values(*) = & - [ "To be ","or not " & - , "to ","be. " & - , "that ","is " & - , "the ","question"] - integer :: me, ni, i - character(len=len(values)) :: my_val, expected + function check_character() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + character(len=*), parameter :: values(*) = & + [ "To be ","or not " & + , "to ","be. " & + , "that ","is " & + , "the ","question"] + character(len=len(values)) my_val + integer me, ni, i - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) - my_val = values(mod(me-1, size(values))+1) - call prif_co_min_character(my_val) + my_val = values(mod(me-1, size(values))+1) + call prif_co_min_character(my_val) - ! issue #205: workaround flang optimizer bug with a temp - associate(tmp => [(values(mod(i-1,size(values))+1), i = 1, ni)]) - expected = minval(tmp) - end associate - result_ = assert_equals(expected, my_val) - end function + ! issue #205: workaround flang optimizer bug with a temp + associate(tmp => [(values(mod(i-1,size(values))+1), i = 1, ni)]) + test_diagnosis = .all. (my_val .equalsExpected. minval(tmp)) + end associate + end function -end module caf_co_min_test +end module prif_co_min_test_m diff --git a/test/prif_co_reduce_test.F90 b/test/prif_co_reduce_test.F90 index ebcbcf22..5c4e2fd0 100644 --- a/test/prif_co_reduce_test.F90 +++ b/test/prif_co_reduce_test.F90 @@ -1,11 +1,32 @@ -module caf_co_reduce_test +#include "language-support.F90" + +module prif_co_reduce_test_m use iso_c_binding, only: c_ptr, c_funptr, c_size_t, c_f_pointer, c_f_procpointer, c_funloc, c_loc, c_null_ptr use prif, only : prif_co_reduce, prif_num_images, prif_this_image_no_coarray, prif_operation_wrapper_interface - use veggies, only : result_t, test_item_t, assert_equals, assert_not, assert_that, describe, it, succeed - + use julienne_m, only : & + operator(.all.) & + ,operator(.also.) & + ,operator(.approximates.) & + ,operator(.equalsExpected.) & + ,operator(.expect.) & + ,operator(.within.) & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t +#if ! HAVE_PROCEDURAL_ACTUAL_FOR_POINTER_DUMMY + use julienne_m, only : diagnosis_function_i +#endif implicit none + private - public :: test_prif_co_reduce + public :: prif_co_reduce_test_t + + type, extends(test_t) :: prif_co_reduce_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type type :: pair integer :: fst @@ -26,21 +47,53 @@ module caf_co_reduce_test contains - function test_prif_co_reduce() result(tests) - type(test_item_t) tests + pure function subject() result(test_subject) + character(len=:), allocatable :: test_subject + test_subject = "The prif_co_reduce subroutine" + end function + +#if HAVE_PROCEDURAL_ACTUAL_FOR_POINTER_DUMMY + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_co_reduce_test_t) prif_co_reduce_test + + test_results = prif_co_reduce_test%run([ & + test_description_t("performing a logical .and. reduction", check_logical) & + ,test_description_t("performing a derived type reduction", check_derived_type_reduction) & +#if HAVE_PARAM_DERIVED + ,test_description_t("performing a parameterized derived type reduction", check_type_parameter_reduction) & +#endif + ]) + end function + +#else + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_co_reduce_test_t) prif_co_reduce_test + procedure(diagnosis_function_i), pointer :: & + check_logical_ptr => check_logical & + ,check_derived_type_reduction_ptr => check_derived_type_reduction +#if HAVE_PARAM_DERIVED + procedure(diagnosis_function_i), pointer :: check_type_parameter_reduction_ptr => check_type_parameter_reduction +#endif - tests = describe( & - "The prif_co_reduce subroutine", & - [ it("can be used to implement logical and reduction", check_logical) & - , it("can be used for reduction on simple derived types", check_derived_type_reduction) & + test_results = prif_co_reduce_test%run([ & + test_description_t("performing a logical .and. reduction", check_logical_ptr) & + ,test_description_t("performing a derived type reduction", check_derived_type_reduction_ptr) & #if HAVE_PARAM_DERIVED - , it("can be used for reduction on derived types with length type parameters", check_type_parameter_reduction) & + ,test_description_t("performing a parameterized derived type reduction", check_type_parameter_reduction_ptr) & #endif ]) end function - function check_logical() result(result_) - type(result_t) :: result_ + +#endif + + + function check_logical() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis logical :: val integer :: me procedure(prif_operation_wrapper_interface), pointer :: op @@ -48,14 +101,14 @@ function check_logical() result(result_) val = .true. call prif_co_reduce(val, op, c_null_ptr) - result_ = assert_that(val) + test_diagnosis = .expect. val call prif_this_image_no_coarray(this_image=me) if (me == 1) then val = .false. end if call prif_co_reduce(val, op, c_null_ptr) - result_ = result_.and.assert_not(val) + test_diagnosis = test_diagnosis .also. (.expect. (.not. val)) end function subroutine and_wrapper(arg1, arg2_and_out, count, cdata) bind(C) @@ -74,8 +127,8 @@ subroutine and_wrapper(arg1, arg2_and_out, count, cdata) bind(C) end do end subroutine - function check_derived_type_reduction() result(result_) - type(result_t) :: result_ + function check_derived_type_reduction() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis type(pair), parameter :: values(*,*) = reshape( & [ pair(1, 53.), pair(3, 47.) & , pair(5, 43.), pair(7, 41.) & @@ -87,6 +140,7 @@ function check_derived_type_reduction() result(result_) type(pair), dimension(size(values,1)) :: my_val, expected type(pair), dimension(:,:), allocatable :: tmp procedure(prif_operation_wrapper_interface), pointer :: op + double precision, parameter :: tolerance = 0D0 op => pair_adder call prif_this_image_no_coarray(this_image=me) @@ -111,9 +165,8 @@ function check_derived_type_reduction() result(result_) #else expected = reduce(tmp, add_pair, dim=2) #endif - result_ = & - assert_equals(expected%fst, my_val%fst) & - .and. assert_equals(real(expected%snd, kind=kind(0.d0)), real(my_val%snd, kind=kind(0.d0))) + test_diagnosis = .all. (my_val%fst .equalsExpected. expected%fst) & + .also. (.all. ( real(my_val%snd, kind=kind(0.d0)) .approximates. real(expected%snd, kind=kind(0.d0)) .within. tolerance)) end function pure function add_pair(lhs, rhs) result(total) @@ -148,8 +201,8 @@ subroutine pair_adder(arg1, arg2_and_out, count, cdata) bind(C) ! Gfortran 14.2 also lacks the type support for this test: ! Error: Derived type 'pdtarray' at (1) is being used before it is defined - function check_type_parameter_reduction() result(result_) - type(result_t) :: result_ + function check_type_parameter_reduction() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis type(array), parameter :: values(*,*) = reshape( & [ array(elements=[1, 53]), array(elements=[3, 47]) & , array(elements=[5, 43]), array(elements=[7, 41]) & @@ -172,9 +225,7 @@ function check_type_parameter_reduction() result(result_) call prif_co_reduce(my_val, op, c_loc(context)) expected = reduce(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), add_array, dim=2) - do i = 1, size(expected) - result_ = result_.and.assert_equals(expected(i)%elements, my_val(i)%elements) - end do + test_diagnosis = .all. (my_val%elements .equalsExpected. expected%elements) end function pure function add_array(lhs, rhs) result(total) @@ -216,4 +267,4 @@ pure function op_interface(lhs, rhs) result(res) end subroutine #endif /* HAVE_PARAM_DERIVED */ -end module caf_co_reduce_test +end module prif_co_reduce_test_m diff --git a/test/prif_co_sum_test.F90 b/test/prif_co_sum_test.F90 index 665b36e4..1fb52fd5 100644 --- a/test/prif_co_sum_test.F90 +++ b/test/prif_co_sum_test.F90 @@ -1,197 +1,262 @@ -module caf_co_sum_test +#include "language-support.F90" + +module prif_co_sum_test_m use iso_c_binding, only: c_int8_t, c_int16_t, c_int32_t, c_int64_t, c_float, c_double use prif, only : prif_co_sum, prif_num_images, prif_this_image_no_coarray - use veggies, only: result_t, test_item_t, assert_equals, describe, it, succeed + use julienne_m, only: & + operator(.all.) & + ,operator(.also.) & + ,operator(.approximates.) & + ,operator(.equalsExpected.) & + ,operator(.within.) & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t +#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + use julienne_m, only : diagnosis_function_i +#endif implicit none private - public :: test_prif_co_sum - -contains - function test_prif_co_sum() result(tests) - type(test_item_t) tests - - tests = describe( & - "The prif_co_sum subroutine computes the sum across images for corresponding elements for", & - [ it("a 1D default integer array", check_default_integer) & - , it("a 1D 8-bit integer array", check_8_bit_integer) & - , it("a 1D 16-bit integer array", check_16_bit_integer) & - , it("32-bit integer scalars", check_32_bit_integer) & - , it("a 1D 64-bit integer array", check_64_bit_integer) & - , it("a 2D 32-bit real array", check_32_bit_real) & - , it("a 1D 64-bit real array", check_64_bit_real) & - , it("a 2D complex array with 32-bit components", check_32_bit_complex) & - , it("a 1D complex array with 64-bit components", check_64_bit_complex) & - ]) - end function - - function check_default_integer() result(result_) - type(result_t) :: result_ - - integer, parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) - integer :: me, ni, i - integer, dimension(size(values,1)) :: my_val, expected - - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) - - my_val = values(:, mod(me-1, size(values,2))+1) - call prif_co_sum(my_val) + public :: prif_co_sum_test_t - expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(int(expected), int(my_val)) - end function + type, extends(test_t) :: prif_co_sum_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type - function check_8_bit_integer() result(result_) - type(result_t) :: result_ - - integer(c_int8_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int8_t), [2, 4]) - integer :: me, ni, i - integer(c_int8_t), dimension(size(values,1)) :: my_val, expected - - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) - - my_val = values(:, mod(me-1, size(values,2))+1) - call prif_co_sum(my_val) - - expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(int(expected), int(my_val)) - end function - - function check_16_bit_integer() result(result_) - type(result_t) :: result_ - - integer(c_int16_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int16_t), [2, 4]) - integer :: me, ni, i - integer(c_int16_t), dimension(size(values,1)) :: my_val, expected +contains - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) + pure function subject() result(test_subject) + character(len=:), allocatable :: test_subject + test_subject = "The prif_co_sum 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_sum_test_t) prif_co_sum_test + + test_results = prif_co_sum_test%run([ & + test_description_t("computing the element-wise sum of a 1D default integer array", check_default_integer) & + ,test_description_t("computing the element-wise sum of a 1D 8-bit integer(c_int8_t) array", check_8_bit_integer) & + ,test_description_t("computing the element-wise sum of a 1D 16-bit integer(c_int16_t) array", check_16_bit_integer) & + ,test_description_t("computing the element-wise sum of integer(c_int32_t) scalars", check_32_bit_integer) & + ,test_description_t("computing the element-wise sum of a 1D 64-bit integer(c_int64_t) array", check_64_bit_integer) & + ,test_description_t("computing the element-wise sum of a 2D 32-bit real(c_float) array", check_32_bit_real) & + ,test_description_t("computing the element-wise sum of a 1D 64-bit real(c_double) array", check_64_bit_real) & + ,test_description_t("computing the element-wise sum of a 2D complex(c_float) array", check_32_bit_complex) & + ,test_description_t("computing the element-wise sum of a 1D complex(c_double) array", check_64_bit_complex) & + ]) + end function + +#else + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_co_sum_test_t) prif_co_sum_test + procedure(diagnosis_function_i), pointer :: & + check_default_integer_ptr => check_default_integer & + ,check_8_bit_integer_ptr => check_8_bit_integer & + ,check_16_bit_integer_ptr => check_16_bit_integer & + ,check_32_bit_integer_ptr => check_32_bit_integer & + ,check_64_bit_integer_ptr => check_64_bit_integer & + ,check_32_bit_real_ptr => check_32_bit_real & + ,check_64_bit_real_ptr => check_64_bit_real & + ,check_32_bit_complex_ptr => check_32_bit_complex & + ,check_64_bit_complex_ptr => check_64_bit_complex + + test_results = prif_co_sum_test%run([ & + test_description_t("computing the element-wise sum of a 1D default integer array", check_default_integer_ptr) & + ,test_description_t("computing the element-wise sum of a 1D 8-bit integer(c_int8_t) array", check_8_bit_integer_ptr) & + ,test_description_t("computing the element-wise sum of a 1D 16-bit integer(c_int16_t) array", check_16_bit_integer_ptr) & + ,test_description_t("computing the element-wise sum of integer(c_int32_t) scalars", check_32_bit_integer_ptr) & + ,test_description_t("computing the element-wise sum of a 1D 64-bit integer(c_int64_t) array", check_64_bit_integer_ptr) & + ,test_description_t("computing the element-wise sum of a 2D 32-bit real(c_float) array", check_32_bit_real_ptr) & + ,test_description_t("computing the element-wise sum of a 1D 64-bit real(c_double) array", check_64_bit_real_ptr) & + ,test_description_t("computing the element-wise sum of a 2D complex(c_float) array", check_32_bit_complex_ptr) & + ,test_description_t("computing the element-wise sum of a 1D complex(c_double) array", check_64_bit_complex_ptr) & + ]) + end function + +#endif + + function check_default_integer() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis - my_val = values(:, mod(me-1, size(values,2))+1) - call prif_co_sum(my_val) + integer, parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) + integer :: me, ni, i + integer, dimension(size(values,1)) :: my_val, expected - expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(int(expected), int(my_val)) - end function + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) + + my_val = values(:, mod(me-1, size(values,2))+1) + call prif_co_sum(my_val) + + expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) + test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + end function - function check_32_bit_integer() result(result_) - type(result_t) :: result_ + function check_8_bit_integer() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + + integer(c_int8_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int8_t), [2, 4]) + integer :: me, ni, i + integer(c_int8_t), dimension(size(values,1)) :: my_val, expected - integer(c_int32_t), parameter :: values(*) = [1, -19, 5, 13, 11, 7, 17, 3] - integer :: me, ni, i - integer(c_int32_t) :: my_val, expected + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) + my_val = values(:, mod(me-1, size(values,2))+1) + call prif_co_sum(my_val) + + expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) + test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + end function + + function check_16_bit_integer() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + + integer(c_int16_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int16_t), [2, 4]) + integer :: me, ni, i + integer(c_int16_t), dimension(size(values,1)) :: my_val, expected + + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) + + my_val = values(:, mod(me-1, size(values,2))+1) + call prif_co_sum(my_val) + + expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) + test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + end function + + function check_32_bit_integer() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + + integer(c_int32_t), parameter :: values(*) = [1, -19, 5, 13, 11, 7, 17, 3] + integer :: me, ni, i + integer(c_int32_t) :: my_val, expected + + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) + + my_val = values(mod(me-1, size(values))+1) + call prif_co_sum(my_val) + + expected = sum([(values(mod(i-1,size(values))+1), i = 1, ni)]) + test_diagnosis = int(my_val) .equalsExpected. int(expected) + end function - my_val = values(mod(me-1, size(values))+1) - call prif_co_sum(my_val) + function check_64_bit_integer() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis - expected = sum([(values(mod(i-1,size(values))+1), i = 1, ni)]) - result_ = assert_equals(expected, my_val) - end function + integer(c_int64_t), parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) + integer :: me, ni, i + integer(c_int64_t), dimension(size(values,1)) :: my_val, expected - function check_64_bit_integer() result(result_) - type(result_t) :: result_ + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) - integer(c_int64_t), parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) - integer :: me, ni, i - integer(c_int64_t), dimension(size(values,1)) :: my_val, expected + my_val = values(:, mod(me-1, size(values,2))+1) + call prif_co_sum(my_val) - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) + expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) + test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + end function - my_val = values(:, mod(me-1, size(values,2))+1) - call prif_co_sum(my_val) + function check_32_bit_real() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis - expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(int(expected), int(my_val)) - end function + real(c_float), parameter :: values(*,*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2,2,2]) + real(c_float), parameter :: tolerance = 0_c_float + integer :: me, ni, i + real(c_float), dimension(size(values,1), size(values,2)) :: my_val, expected - function check_32_bit_real() result(result_) - type(result_t) :: result_ + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) - real(c_float), parameter :: values(*,*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2,2,2]) - integer :: me, ni, i - real(c_float), dimension(size(values,1), size(values,2)) :: my_val, expected + my_val = values(:, :, mod(me-1, size(values,3))+1) + call prif_co_sum(my_val) - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) + expected = sum(reshape([(values(:,:,mod(i-1,size(values,3))+1), i = 1, ni)], [size(values,1), size(values,2), ni]), dim=3) + test_diagnosis = .all. (my_val .approximates. expected .within. tolerance) + end function - my_val = values(:, :, mod(me-1, size(values,3))+1) - call prif_co_sum(my_val) + function check_64_bit_real() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis - expected = sum(reshape([(values(:,:,mod(i-1,size(values,3))+1), i = 1, ni)], [size(values,1), size(values,2), ni]), dim=3) - result_ = assert_equals(real(expected,kind=c_double), real(my_val,kind=c_double)) - end function + real(c_double), parameter :: values(*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2, 4]) + real(c_double), parameter :: tolerance = 0_c_double + integer :: me, ni, i + real(c_double), dimension(size(values,1)) :: my_val, expected - function check_64_bit_real() result(result_) - type(result_t) :: result_ + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) - real(c_double), parameter :: values(*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2, 4]) - integer :: me, ni, i - real(c_double), dimension(size(values,1)) :: my_val, expected + my_val = values(:, mod(me-1, size(values,2))+1) + call prif_co_sum(my_val) - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) + expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) + test_diagnosis = .all. (my_val .approximates. expected .within. tolerance) + end function - my_val = values(:, mod(me-1, size(values,2))+1) - call prif_co_sum(my_val) + function check_32_bit_complex() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis - expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - result_ = assert_equals(expected, my_val) - end function + complex(c_float), parameter :: values(*,*,*) = reshape( & + [ cmplx(1., 53.), cmplx(3., 47.) & + , cmplx(5., 43.), cmplx(7., 41.) & + , cmplx(11., 37.), cmplx(13., 31.) & + , cmplx(17., 29.), cmplx(19., 23.) & + ], & + [2,2,2]) + real(c_float), parameter :: tolerance = 0_c_float + integer :: me, ni, i + complex(c_float), dimension(size(values,1),size(values,2)) :: my_val, expected - function check_32_bit_complex() result(result_) - type(result_t) :: result_ + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) - complex(c_float), parameter :: values(*,*,*) = reshape( & - [ cmplx(1., 53.), cmplx(3., 47.) & - , cmplx(5., 43.), cmplx(7., 41.) & - , cmplx(11., 37.), cmplx(13., 31.) & - , cmplx(17., 29.), cmplx(19., 23.) & - ], & - [2,2,2]) - integer :: me, ni, i - complex(c_float), dimension(size(values,1),size(values,2)) :: my_val, expected + my_val = values(:, :, mod(me-1, size(values,3))+1) + call prif_co_sum(my_val) - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) + expected = sum(reshape([(values(:,:,mod(i-1,size(values,3))+1), i = 1, ni)], [size(values,1), size(values,2), ni]), dim=3) - my_val = values(:, :, mod(me-1, size(values,3))+1) - call prif_co_sum(my_val) + test_diagnosis = & + .all. (real(my_val) .approximates. real(expected) .within. tolerance) & + .also. (.all. (aimag(my_val) .approximates. aimag(expected) .within. tolerance)) + end function - expected = sum(reshape([(values(:,:,mod(i-1,size(values,3))+1), i = 1, ni)], [size(values,1), size(values,2), ni]), dim=3) - result_ = & - assert_equals(real(expected, kind=c_double), real(my_val, kind=c_double)) & - .and.assert_equals(real(aimag(expected), kind=c_double), real(aimag(my_val), kind=c_double)) - end function + function check_64_bit_complex() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis - function check_64_bit_complex() result(result_) - type(result_t) :: result_ + complex(c_double), parameter :: values(*,*) = reshape( & + [ cmplx(1., 53.), cmplx(3., 47.) & + , cmplx(5., 43.), cmplx(7., 41.) & + , cmplx(11., 37.), cmplx(13., 31.) & + , cmplx(17., 29.), cmplx(19., 23.) & + ], & + [2,4]) + real(c_double), parameter :: tolerance = 0_c_double + integer me, ni, i + complex(c_double), dimension(size(values,1)) :: my_val, expected - complex(c_double), parameter :: values(*,*) = reshape( & - [ cmplx(1., 53.), cmplx(3., 47.) & - , cmplx(5., 43.), cmplx(7., 41.) & - , cmplx(11., 37.), cmplx(13., 31.) & - , cmplx(17., 29.), cmplx(19., 23.) & - ], & - [2,4]) - integer :: me, ni, i - complex(c_double), dimension(size(values,1)) :: my_val, expected + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) + my_val = values(:, mod(me-1, size(values,2))+1) + call prif_co_sum(my_val) - my_val = values(:, mod(me-1, size(values,2))+1) - call prif_co_sum(my_val) + expected = sum(reshape([(values(:,mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1), ni]), dim=2) - expected = sum(reshape([(values(:,mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1), ni]), dim=2) - result_ = & - assert_equals(real(expected), real(my_val)) & - .and.assert_equals(aimag(expected), aimag(my_val)) - end function + test_diagnosis = & + .all. (real(my_val, c_double) .approximates. real(expected, c_double) .within. tolerance) & + .also. (.all. (real(aimag(my_val), c_double) .approximates. real(aimag(expected), c_double) .within. tolerance)) + end function -end module caf_co_sum_test +end module prif_co_sum_test_m diff --git a/test/prif_coarray_inquiry_test.F90 b/test/prif_coarray_inquiry_test.F90 index f2e1298d..097430a8 100644 --- a/test/prif_coarray_inquiry_test.F90 +++ b/test/prif_coarray_inquiry_test.F90 @@ -1,135 +1,159 @@ -module caf_coarray_inquiry_test - use prif, only : & - prif_allocate_coarray, prif_deallocate_coarray, & - prif_coarray_handle, prif_num_images, & - prif_local_data_pointer, prif_size_bytes, & - prif_lcobound_no_dim, prif_lcobound_with_dim, & - prif_ucobound_no_dim, prif_ucobound_with_dim, & - prif_coshape - use veggies, only: result_t, test_item_t, assert_that, describe, it, succeed - use iso_c_binding, only: & - c_ptr, c_null_ptr, c_int64_t, c_int, c_size_t, c_null_funptr, c_associated - - implicit none - private - public :: test_coarray_inquiry +#include "language-support.F90" + +module prif_coarray_inquiry_test_m + use prif, only : & + prif_allocate_coarray, prif_deallocate_coarray, & + prif_coarray_handle, prif_num_images, & + prif_local_data_pointer, prif_size_bytes, & + prif_lcobound_no_dim, prif_lcobound_with_dim, & + prif_ucobound_no_dim, prif_ucobound_with_dim, & + prif_coshape + use julienne_m, only: & + operator(//) & + ,operator(.all.) & + ,operator(.also.) & + ,operator(.equalsExpected.) & + ,operator(.expect.) & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t +#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + use julienne_m, only : diagnosis_function_i +#endif + use iso_c_binding, only: & + c_ptr, c_null_ptr, c_int64_t, c_int, c_size_t, c_null_funptr, c_associated + + implicit none + private + public :: prif_coarray_inquiry_test_t + + type, extends(test_t) :: prif_coarray_inquiry_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type + contains - function test_coarray_inquiry() result(tests) - type(test_item_t) :: tests - - tests = & - describe( & - "PRIF coarray inquiry functions", & - [ describe( & - "prif_local_data_pointer", & - [ it( & - "returns the same pointer as when the coarray was allocated", & - check_prif_local_data_pointer) & - ]), & - describe( & - "PRIF coarrays", & - [ it("pass cobounds testing", check_cobounds) ]) & - ]) - end function - - function check_prif_local_data_pointer() result(result_) - type(result_t) :: result_ - - integer(kind=c_int64_t), dimension(1) :: lcobounds, ucobounds - integer :: dummy_element, num_imgs - type(prif_coarray_handle) :: coarray_handle - type(c_ptr) :: allocation_ptr, local_ptr - - call prif_num_images(num_images=num_imgs) - lcobounds(1) = 1 - ucobounds(1) = num_imgs - - call prif_allocate_coarray( & - lcobounds, & - ucobounds, & - int(storage_size(dummy_element)/8, c_size_t), & - c_null_funptr, & - coarray_handle, & - allocation_ptr) - call prif_local_data_pointer(coarray_handle, local_ptr) - result_ = assert_that(c_associated(local_ptr, allocation_ptr)) - call prif_deallocate_coarray([coarray_handle]) - end function - - function check_cobound(corank) result(result_) - type(result_t) :: result_ - integer(c_int), intent(in) :: corank - - ! Allocate memory for an integer scalar coarray with given corank - ! and then test some queries on it - - integer :: num_imgs, i - integer(kind=c_int64_t), dimension(corank) :: lcobounds, ucobounds, tmp_bounds - integer(kind=c_int64_t) :: tmp_bound - integer(kind=c_size_t), dimension(corank) :: sizes + + pure function subject() result(test_subject) + character(len=:), allocatable :: test_subject + test_subject = "The PRIF coarray inquiry subroutines" + end function + +#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_coarray_inquiry_test_t) prif_coarray_inquiry_test + + test_results = prif_coarray_inquiry_test%run([ & + test_description_t("preserving the prif_local_data_pointer for an allocated coarray", check_prif_local_data_pointer) & + ,test_description_t("checking passed cobounds", check_cobounds) & + ]) + end function + +#else + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_coarray_inquiry_test_t) prif_coarray_inquiry_test + procedure(diagnosis_function_i), pointer :: & + check_prif_local_data_pointer_ptr => check_prif_local_data_pointer & + ,check_cobounds_ptr => check_cobounds + + test_results = prif_coarray_inquiry_test%run([ & + test_description_t("preserving the prif_local_data_pointer for an allocated coarray", check_prif_local_data_pointer_ptr) & + ,test_description_t("checking passed cobounds", check_cobounds_ptr) & + ]) + end function + +#endif + + function check_prif_local_data_pointer() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + + integer(kind=c_int64_t), dimension(1) :: lcobounds, ucobounds + integer :: dummy_element, num_imgs type(prif_coarray_handle) :: coarray_handle - type(c_ptr) :: allocated_memory - integer(c_size_t) :: data_size, query_size - - result_ = succeed("") - + type(c_ptr) :: allocation_ptr, local_ptr + call prif_num_images(num_images=num_imgs) lcobounds(1) = 1 ucobounds(1) = num_imgs - do i = 2,corank - lcobounds(i) = i - ucobounds(i) = i*2 - end do - - allocated_memory = c_null_ptr - data_size = 64 * corank - + call prif_allocate_coarray( & - lcobounds, ucobounds, data_size, c_null_funptr, & - coarray_handle, allocated_memory) - - result_ = result_ .and. & - assert_that(c_associated(allocated_memory)) - - call prif_size_bytes(coarray_handle, data_size=query_size) - result_ = result_ .and. & - assert_that(query_size == data_size, "prif_size_bytes is valid") - - call prif_lcobound_no_dim(coarray_handle, tmp_bounds) - result_ = result_ .and. & - assert_that(all(tmp_bounds == lcobounds), "prif_lcobound_no_dim is valid") - - call prif_ucobound_no_dim(coarray_handle, tmp_bounds) - result_ = result_ .and. & - assert_that(all(tmp_bounds == ucobounds), "prif_ucobound_no_dim is valid") - - do i = 1,corank - call prif_lcobound_with_dim(coarray_handle, i, tmp_bound) - result_ = result_ .and. & - assert_that(tmp_bound == lcobounds(i), "prif_lcobound_with_dim is valid") - - call prif_ucobound_with_dim(coarray_handle, i, tmp_bound) - result_ = result_ .and. & - assert_that(tmp_bound == ucobounds(i), "prif_ucobound_with_dim is valid") - end do - - call prif_coshape(coarray_handle, sizes) - result_ = result_ .and. & - assert_that(all(sizes == (ucobounds - lcobounds + 1)), "prif_coshape is valid") - + lcobounds, & + ucobounds, & + int(storage_size(dummy_element)/8, c_size_t), & + c_null_funptr, & + coarray_handle, & + allocation_ptr) + call prif_local_data_pointer(coarray_handle, local_ptr) + test_diagnosis = .expect. c_associated(local_ptr, allocation_ptr) call prif_deallocate_coarray([coarray_handle]) - end function - - function check_cobounds() result(result_) - type(result_t) :: result_ - integer(c_int) :: corank - - result_ = succeed("") - - do corank = 1, 15 - result_ = result_ .and. check_cobound(corank) - end do - - end function - -end module + end function + + impure elemental function check_cobound(corank) result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + integer(c_int), intent(in) :: corank + + ! Allocate memory for an integer scalar coarray with given corank + ! and then test some queries on it + + integer :: num_imgs, i + integer(kind=c_int64_t), dimension(corank) :: lcobounds, ucobounds, tmp_bounds + integer(kind=c_int64_t) :: tmp_bound + integer(kind=c_size_t), dimension(corank) :: sizes + type(prif_coarray_handle) :: coarray_handle + type(c_ptr) :: allocated_memory + integer(c_size_t) :: data_size, query_size + + call prif_num_images(num_images=num_imgs) + lcobounds(1) = 1 + ucobounds(1) = num_imgs + do i = 2,corank + lcobounds(i) = i + ucobounds(i) = i*2 + end do + + allocated_memory = c_null_ptr + data_size = 64 * corank + + call prif_allocate_coarray( & + lcobounds, ucobounds, data_size, c_null_funptr, & + coarray_handle, allocated_memory) + + test_diagnosis = .expect. c_associated(allocated_memory) + + call prif_size_bytes(coarray_handle, data_size=query_size) + test_diagnosis = test_diagnosis .also. (query_size .equalsExpected. data_size) // "prif_size_bytes is valid" + + call prif_lcobound_no_dim(coarray_handle, tmp_bounds) + test_diagnosis = test_diagnosis .also. (.all. (tmp_bounds .equalsExpected. lcobounds)) // "prif_lcobound_no_dim is valid" + + call prif_ucobound_no_dim(coarray_handle, tmp_bounds) + test_diagnosis = test_diagnosis .also. (.all. (tmp_bounds .equalsExpected. ucobounds)) // "prif_ucobound_no_dim is valid" + + do i = 1, corank + call prif_lcobound_with_dim(coarray_handle, i, tmp_bound) + test_diagnosis = test_diagnosis .also. (tmp_bound .equalsExpected. lcobounds(i)) // "prif_lcobound_with_dim is valid" + + call prif_ucobound_with_dim(coarray_handle, i, tmp_bound) + test_diagnosis = test_diagnosis .also. (tmp_bound .equalsExpected. ucobounds(i)) // "prif_ucobound_with_dim is valid" + end do + + call prif_coshape(coarray_handle, sizes) + test_diagnosis = test_diagnosis .also. (.all. ((ucobounds - lcobounds + 1) .equalsExpected. sizes)) // "prif_coshape is valid" + + call prif_deallocate_coarray([coarray_handle]) + end function + + function check_cobounds() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + integer(c_int) :: corank + + test_diagnosis = .all. check_cobound([(corank, corank = 1_c_int, 15_c_int)]) + end function + +end module prif_coarray_inquiry_test_m diff --git a/test/prif_image_queries_test.F90 b/test/prif_image_queries_test.F90 index d416131a..382f3c02 100644 --- a/test/prif_image_queries_test.F90 +++ b/test/prif_image_queries_test.F90 @@ -1,61 +1,111 @@ -module caf_image_queries_test +#include "language-support.F90" + +module prif_image_queries_test_m use iso_c_binding, only: c_int use prif, only : prif_image_status, prif_stopped_images, prif_failed_images, PRIF_STAT_FAILED_IMAGE, PRIF_STAT_STOPPED_IMAGE use prif, only : prif_num_images - use veggies, only: result_t, test_item_t, assert_that, describe, it, succeed + use julienne_m, only: & + operator(//) & + ,operator(.all.) & + ,operator(.also.) & + ,operator(.isAtLeast.) & + ,operator(.isAtMost.) & + ,operator(.lessThan.) & + ,operator(.expect.) & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t +#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + use julienne_m, only: diagnosis_function_i +#endif implicit none private - public :: test_prif_image_queries + public :: prif_image_queries_test_t + + type, extends(test_t) :: prif_image_queries_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type contains - function test_prif_image_queries() result(tests) - type(test_item_t) :: tests - - tests = describe( & - "PRIF image queries", [ & - it("provide valid prif_image_status()", check_image_status), & - it("provide valid prif_stopped_images()", check_stopped_images), & - it("provide valid prif_failed_images()", check_failed_images) & - ]) - end function - - function check_image_status() result(result_) - type(result_t) :: result_ - integer(c_int) :: image_status - - call prif_image_status(1, image_status=image_status) - result_ = assert_that(image_status == 0 .or. & - image_status == PRIF_STAT_FAILED_IMAGE .or. & - image_status == PRIF_STAT_STOPPED_IMAGE, "permitted image status") - end function - - function valid_image_list(nums) result(result_) - integer, allocatable, intent(in) :: nums(:) - type(result_t) :: result_ - integer i, ni - - call prif_num_images(num_images=ni) - result_ = assert_that( allocated(nums) .and. size(nums) <= ni .and. & - all([(nums(i) >= 1 .and. nums(i) <= ni, i = 1, size(nums))]) .and. & - all([(nums(i) < nums(i+1), i = 1, size(nums)-1)]), & - "valid stopped images") - end function - - function check_stopped_images() result(result_) - type(result_t) :: result_ - integer, allocatable :: nums(:) - - call prif_stopped_images(stopped_images=nums) - result_ = valid_image_list(nums) - end function - - function check_failed_images() result(result_) - type(result_t) :: result_ - integer, allocatable :: nums(:) - - call prif_failed_images(failed_images=nums) - result_ = valid_image_list(nums) - end function - -end module caf_image_queries_test + + pure function subject() result(test_subject) + character(len=:), allocatable :: test_subject + test_subject = "PRIF image queries" + end function + +#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_image_queries_test_t) prif_image_queries_test + + test_results = prif_image_queries_test%run([ & + test_description_t("providing valid prif_image_status()", check_image_status) & + ,test_description_t("providing valid prif_stopped_images()", check_stopped_images) & + ,test_description_t("providing valid prif_failed_images()", check_failed_images) & + ]) + end function + +#else + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_image_queries_test_t) prif_image_queries_test + procedure(diagnosis_function_i), pointer :: & + check_image_status_ptr => check_image_status & + ,check_stopped_images_ptr => check_stopped_images & + ,check_failed_images_ptr => check_failed_images + + test_results = prif_image_queries_test%run([ & + test_description_t("providing valid prif_image_status()", check_image_status_ptr) & + ,test_description_t("providing valid prif_stopped_images()", check_stopped_images_ptr) & + ,test_description_t("providing valid prif_failed_images()", check_failed_images_ptr) & + ]) + end function + +#endif + + function check_image_status() result(test_diagnosis) + type(test_diagnosis_t) :: test_diagnosis + integer(c_int) :: image_status + + call prif_image_status(1, image_status=image_status) + test_diagnosis = .expect. (any(image_status == [0, PRIF_STAT_FAILED_IMAGE, PRIF_STAT_STOPPED_IMAGE])) & ! TODO: replace with .any. once Juliennes supports it + // "permitted image status" + end function + + function valid_image_list(nums) result(test_diagnosis) + integer, allocatable, intent(in) :: nums(:) + type(test_diagnosis_t) test_diagnosis + integer ni + + call prif_num_images(num_images=ni) + test_diagnosis = & + .expect. allocated(nums) & + .also. (size(nums) .isAtMost. ni) & + .also. (.all. (nums .isAtLeast. 1)) & + .also. (.all. (nums .isAtMost. ni)) & + .also. (.all. (nums(1:size(nums)-1) .lessThan. nums(2:size(nums)))) // "valid stopped image" + end function + + function check_stopped_images() result(test_diagnosis) + type(test_diagnosis_t) :: test_diagnosis + integer, allocatable :: nums(:) + + call prif_stopped_images(stopped_images=nums) + test_diagnosis = valid_image_list(nums) + end function + + function check_failed_images() result(test_diagnosis) + type(test_diagnosis_t) :: test_diagnosis + integer, allocatable :: nums(:) + + call prif_failed_images(failed_images=nums) + test_diagnosis = valid_image_list(nums) + end function + +end module prif_image_queries_test_m diff --git a/test/prif_init_test.F90 b/test/prif_init_test.F90 new file mode 100644 index 00000000..5933279f --- /dev/null +++ b/test/prif_init_test.F90 @@ -0,0 +1,86 @@ +#include "language-support.F90" + +module prif_init_test_m + use prif, only : prif_init, PRIF_STAT_ALREADY_INIT + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, operator(.equalsExpected.) +#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + use julienne_m, only: diagnosis_function_i +#endif + + implicit none + private + public :: prif_init_test_t + + type, extends(test_t) :: prif_init_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type + +contains + + pure function subject() result(test_subject) + character(len=:), allocatable :: test_subject + test_subject = "The prif_init subroutine" + end function + +#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_init_test_t) prif_init_test + + test_results = prif_init_test%run([ & + test_description_t("completing successfully", check_caffeination) & + ,test_description_t("returning PRIF_STAT_ALREADY_INIT on a subsequent call ", check_subsequent_prif_init_call) & + ]) + end function + +#else + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_init_test_t) prif_init_test + procedure(diagnosis_function_i), pointer :: & + check_caffeination_ptr => check_caffeination & + ,check_subsequent_prif_init_call_ptr => check_subsequent_prif_init_call + + test_results = prif_init_test%run([ & + test_description_t("completing successfully", check_caffeination_ptr) & + ,test_description_t("returning PRIF_STAT_ALREADY_INIT on a subsequent call ", check_subsequent_prif_init_call_ptr) & + ]) + end function + +#endif + + function check_caffeination() result(test_diagnosis) + ! this test needs to run very early at startup, so we memoize the result + type(test_diagnosis_t) :: test_diagnosis + type(test_diagnosis_t), save :: memo + logical, save :: first_pass = .true. + + if (first_pass) then + first_pass = .false. + write_memo: & + block + integer, parameter :: successful_initiation = 0 + integer init_exit_code + + call prif_init(init_exit_code) + memo = init_exit_code .equalsExpected. successful_initiation + end block write_memo + endif + + test_diagnosis = memo + end function + + function check_subsequent_prif_init_call() result(test_diagnosis) + type(test_diagnosis_t) :: test_diagnosis + integer stat + + call prif_init(stat) + call prif_init(stat) + test_diagnosis = stat .equalsExpected. PRIF_STAT_ALREADY_INIT + end function + +end module prif_init_test_m diff --git a/test/prif_num_images_test.F90 b/test/prif_num_images_test.F90 index 4640a15a..c62856a0 100644 --- a/test/prif_num_images_test.F90 +++ b/test/prif_num_images_test.F90 @@ -1,27 +1,66 @@ -module caf_num_images_test +#include "language-support.F90" + +module prif_num_images_test_m use prif, only : prif_num_images - use veggies, only: result_t, test_item_t, assert_that, describe, it + use julienne_m, only: & + operator(//) & + ,operator(.isAtLeast.) & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t +#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + use julienne_m, only: diagnosis_function_i +#endif implicit none private - public :: test_prif_num_images + public :: prif_num_images_test_t + + type, extends(test_t) :: prif_num_images_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type contains - function test_prif_num_images() result(tests) - type(test_item_t) :: tests - tests = & - describe( & - "The prif_num_images function result", & - [ it("is a valid number of images when invoked with no arguments", check_num_images_valid) & + pure function subject() result(test_subject) + character(len=:), allocatable :: test_subject + test_subject = "The prif_num_images function" + end function + +#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_num_images_test_t) prif_num_images_test + + test_results = prif_num_images_test%run([ & + test_description_t("returning a valid number of images when invoked with no arguments", check_num_images_valid) & ]) end function - function check_num_images_valid() result(result_) - type(result_t) :: result_ - integer :: num_imgs +#else + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_num_images_test_t) prif_num_images_test + procedure(diagnosis_function_i), pointer :: & + check_num_images_valid_ptr => check_num_images_valid + + test_results = prif_num_images_test%run([ & + test_description_t("returning a valid number of images when invoked with no arguments", check_num_images_valid_ptr) & + ]) + end function + +#endif + + function check_num_images_valid() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + integer num_imgs call prif_num_images(num_images=num_imgs) - result_ = assert_that(num_imgs>0, "positive number of images") + test_diagnosis = (num_imgs .isAtLeast. 1) // "positive number of images" end function -end module caf_num_images_test +end module prif_num_images_test_m diff --git a/test/prif_sync_images_test.F90 b/test/prif_sync_images_test.F90 index d719c8dd..d20d8c4d 100644 --- a/test/prif_sync_images_test.F90 +++ b/test/prif_sync_images_test.F90 @@ -1,30 +1,69 @@ -module caf_sync_images_test +#include "language-support.F90" + +module prif_sync_images_test_m use iso_c_binding, only: c_int use prif, only : prif_sync_images, prif_this_image_no_coarray, prif_num_images, prif_sync_all - use veggies, only: result_t, test_item_t, assert_that, describe, it, succeed + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, operator(.expect.) + +#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + use julienne_m, only: diagnosis_function_i +#endif implicit none private - public :: test_prif_sync_images + public :: prif_sync_images_test_t + type, extends(test_t) :: prif_sync_images_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type + integer, parameter :: lim = 10 contains - function test_prif_sync_images() result(tests) - type(test_item_t) :: tests - - tests = describe( & - "PRIF sync images", [ & - it("pass serial prif_sync_images test", check_serial), & - it("pass prif_sync_images neighbor test", check_neighbor), & - it("pass prif_sync_images hot-spot test", check_hot) & + + pure function subject() result(test_subject) + character(len=:), allocatable :: test_subject + test_subject = "The prif_sync_images subroutine" + end function + +#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_sync_images_test_t) prif_sync_images_test + + test_results = prif_sync_images_test%run([ & + test_description_t("synchronizing an image with itself", check_serial), & + test_description_t("synchronizing with a neighbor", check_neighbor), & + test_description_t("synchronizing every image with one image", check_hot) & ]) end function - function check_serial() result(result_) - type(result_t) :: result_ +#else + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_sync_images_test_t) prif_sync_images_test + procedure(diagnosis_function_i), pointer :: & + check_serial_ptr => check_serial & + ,check_neighbor_ptr => check_neighbor & + ,check_hot_ptr => check_hot + + test_results = prif_sync_images_test%run([ & + test_description_t("synchronizing an image with itself", check_serial_ptr), & + test_description_t("synchronizing with a neighbor", check_neighbor_ptr), & + test_description_t("synchronizing every image with one image", check_hot_ptr) & + ]) + end function + +#endif + + function check_serial() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis integer(c_int) :: me - integer :: i + integer i call prif_this_image_no_coarray(this_image=me) call prif_sync_all @@ -35,14 +74,14 @@ function check_serial() result(result_) end do call prif_sync_all - result_ = succeed("") + test_diagnosis = .expect. .true. end function - function check_neighbor() result(result_) - type(result_t) :: result_ - integer(c_int) :: me, num_imgs - integer :: i + function check_neighbor() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + integer(c_int) me, num_imgs + integer i call prif_this_image_no_coarray(this_image=me) call prif_num_images(num_images=num_imgs) @@ -55,11 +94,11 @@ function check_neighbor() result(result_) end do call prif_sync_all - result_ = succeed("") + test_diagnosis = .expect. .true. end function - function check_hot() result(result_) - type(result_t) :: result_ + function check_hot() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis integer(c_int) :: me, num_imgs integer :: i @@ -87,8 +126,7 @@ function check_hot() result(result_) endif call prif_sync_all - result_ = succeed("") + test_diagnosis = .expect. .true. end function - -end module +end module prif_sync_images_test_m diff --git a/test/prif_this_image_test.F90 b/test/prif_this_image_test.F90 index e6bf04ca..44dc8361 100644 --- a/test/prif_this_image_test.F90 +++ b/test/prif_this_image_test.F90 @@ -1,33 +1,71 @@ -module caf_this_image_test - use prif, only : prif_this_image_no_coarray, prif_num_images, prif_co_sum - use veggies, only: result_t, test_item_t, assert_that, describe, it, succeed +#include "language-support.F90" - implicit none - private - public :: test_prif_this_image_no_coarray +module prif_this_image_no_coarray_test_m + use prif, only : prif_this_image_no_coarray, prif_num_images, prif_co_sum + use julienne_m, only: & + operator(//) & + ,operator(.all.) & + ,operator(.equalsExpected.) & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t +#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + use julienne_m, only: diagnosis_function_i +#endif + implicit none + + private + public :: prif_this_image_no_coarray_test_t + + type, extends(test_t) :: prif_this_image_no_coarray_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type contains - function test_prif_this_image_no_coarray() result(tests) - type(test_item_t) :: tests - - tests = describe( & - "The prif_this_image_no_coarray function result", & - [ it("is the proper member of the set {1,2,...,num_images()} when invoked as this_image()", check_this_image_set) & - ]) - end function - - function check_this_image_set() result(result_) - type(result_t) :: result_ - integer, allocatable :: image_numbers(:) - integer i, me, ni - - allocate(image_numbers(0)) - - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(num_images=ni) - image_numbers = [(merge(0, me, me/=i), i = 1, ni)] - call prif_co_sum(image_numbers) - result_ = assert_that(all(image_numbers == [(i, i = 1, ni)]) .and. size(image_numbers)>0, "correct image set") - end function - -end module caf_this_image_test + pure function subject() result(test_subject) + character(len=:), allocatable :: test_subject + test_subject = "The prif_this_image_no_coarray subroutine" + end function + +#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_this_image_no_coarray_test_t) prif_this_image_no_coarray_test + + test_results = prif_this_image_no_coarray_test%run([ & + test_description_t("returning a unique member of {1,...,num_images()} when called without arguments", check_this_image_set) & + ]) + end function + +#else + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_this_image_no_coarray_test_t) prif_this_image_no_coarray_test + procedure(diagnosis_function_i), pointer :: & + check_this_image_set_ptr => check_this_image_set + + test_results = prif_this_image_no_coarray_test%run([ & + test_description_t("returning a unique member of {1,...,num_images()} when called without arguments", check_this_image_set_ptr) & + ]) + end function + +#endif + + function check_this_image_set() result(test_diagnosis) + type(test_diagnosis_t) :: test_diagnosis + integer, allocatable :: image_numbers(:) + integer i, me, ni + + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(num_images=ni) + image_numbers = [(merge(0, me, me/=i), i = 1, ni)] + call prif_co_sum(image_numbers) + test_diagnosis = .all. (image_numbers .equalsExpected. [(i, i = 1, ni)]) // "correct image set" + end function + +end module prif_this_image_no_coarray_test_m From 9f8ba7cf681edea210a25b72297e3f506e350583 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 7 Nov 2025 12:06:51 -0800 Subject: [PATCH 03/13] Deploy julienne usher workaround --- test/prif_co_broadcast_test.F90 | 29 +++------------- test/prif_co_max_test.F90 | 50 +++++---------------------- test/prif_co_min_test.F90 | 51 +++++---------------------- test/prif_co_reduce_test.F90 | 37 +++----------------- test/prif_co_sum_test.F90 | 55 ++++++------------------------ test/prif_coarray_inquiry_test.F90 | 27 ++------------- test/prif_image_queries_test.F90 | 31 +++-------------- test/prif_init_test.F90 | 27 ++------------- test/prif_num_images_test.F90 | 22 ++---------- test/prif_sync_images_test.F90 | 33 +++--------------- test/prif_this_image_test.F90 | 23 ++----------- 11 files changed, 54 insertions(+), 331 deletions(-) diff --git a/test/prif_co_broadcast_test.F90 b/test/prif_co_broadcast_test.F90 index 092a4745..8738e3ae 100644 --- a/test/prif_co_broadcast_test.F90 +++ b/test/prif_co_broadcast_test.F90 @@ -3,16 +3,14 @@ module prif_co_broadcast_test_m use prif, only : prif_co_broadcast, prif_num_images, prif_this_image_no_coarray use julienne_m, only : & - test_description_t & + usher & + ,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 @@ -42,35 +40,16 @@ pure function subject() result(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) & + 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)) & ]) 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([ & diff --git a/test/prif_co_max_test.F90 b/test/prif_co_max_test.F90 index 6ca0d8d6..f6ec5e28 100644 --- a/test/prif_co_max_test.F90 +++ b/test/prif_co_max_test.F90 @@ -8,13 +8,11 @@ module prif_co_max_test_m ,operator(.approximates.) & ,operator(.within.) & ,operator(.equalsExpected.) & + ,usher & ,test_description_t & ,test_diagnosis_t & ,test_result_t & ,test_t -#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - use julienne_m, only : diagnosis_function_i -#endif implicit none @@ -34,52 +32,22 @@ pure function subject() result(test_subject) test_subject = "The prif_co_max 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_max_test_t) prif_co_max_test - - test_results = prif_co_max_test%run([ & - test_description_t("computing element-wise maxima for integer(c_int32_t) scalars", check_32_bit_integer) & - ,test_description_t("computing element-wise maxima for a 1D default integer array", check_default_integer) & - ,test_description_t("computing element-wise maxima for a 1D integer(c_int8_t) array", check_8_bit_integer) & - ,test_description_t("computing element-wise maxima for a 1D integer(c_int16_t) array", check_16_bit_integer) & - ,test_description_t("computing element-wise maxima for a 1D integer(c_int64_t array", check_64_bit_integer) & - ,test_description_t("computing element-wise maxima for a 2D real(c_float) array", check_32_bit_real) & - ,test_description_t("computing element-wise maxima for a 1D real(c_double array", check_64_bit_real) & - ,test_description_t("computing element-wise maxima for character scalars", check_character) & - ]) - end function - -#else - function results() result(test_results) type(test_result_t), allocatable :: test_results(:) type(prif_co_max_test_t) prif_co_max_test - procedure(diagnosis_function_i), pointer :: & - check_32_bit_integer_ptr => check_32_bit_integer & - ,check_default_integer_ptr => check_default_integer & - ,check_8_bit_integer_ptr => check_8_bit_integer & - ,check_16_bit_integer_ptr => check_16_bit_integer & - ,check_64_bit_integer_ptr => check_64_bit_integer & - ,check_32_bit_real_ptr => check_32_bit_real & - ,check_64_bit_real_ptr => check_64_bit_real & - ,check_character_ptr => check_character test_results = prif_co_max_test%run([ & - test_description_t("computing element-wise maxima for integer(c_int32_t) scalars", check_32_bit_integer_ptr) & - ,test_description_t("computing element-wise maxima for a 1D default integer array", check_default_integer_ptr) & - ,test_description_t("computing element-wise maxima for a 1D integer(c_int8_t) array", check_8_bit_integer_ptr) & - ,test_description_t("computing element-wise maxima for a 1D integer(c_int16_t) array", check_16_bit_integer_ptr) & - ,test_description_t("computing element-wise maxima for a 1D integer(c_int64_t array", check_64_bit_integer_ptr) & - ,test_description_t("computing element-wise maxima for a 2D real(c_float) array", check_32_bit_real_ptr) & - ,test_description_t("computing element-wise maxima for a 1D real(c_double array", check_64_bit_real_ptr) & - ,test_description_t("computing element-wise maxima for character scalars", check_character_ptr) & + test_description_t("computing element-wise maxima for integer(c_int32_t) scalars", usher(check_32_bit_integer)) & + ,test_description_t("computing element-wise maxima for a 1D default integer array", usher(check_default_integer)) & + ,test_description_t("computing element-wise maxima for a 1D integer(c_int8_t) array", usher(check_8_bit_integer)) & + ,test_description_t("computing element-wise maxima for a 1D integer(c_int16_t) array", usher(check_16_bit_integer)) & + ,test_description_t("computing element-wise maxima for a 1D integer(c_int64_t array", usher(check_64_bit_integer)) & + ,test_description_t("computing element-wise maxima for a 2D real(c_float) array", usher(check_32_bit_real)) & + ,test_description_t("computing element-wise maxima for a 1D real(c_double array", usher(check_64_bit_real)) & + ,test_description_t("computing element-wise maxima for character scalars", usher(check_character)) & ]) end function -#endif function check_default_integer() result(test_diagnosis) type(test_diagnosis_t) :: test_diagnosis diff --git a/test/prif_co_min_test.F90 b/test/prif_co_min_test.F90 index fe4e7740..603b55e8 100644 --- a/test/prif_co_min_test.F90 +++ b/test/prif_co_min_test.F90 @@ -8,13 +8,11 @@ module prif_co_min_test_m ,operator(.approximates.) & ,operator(.within.) & ,operator(.equalsExpected.) & + ,usher & ,test_description_t & ,test_diagnosis_t & ,test_result_t & ,test_t -#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - use julienne_m, only : diagnosis_function_i -#endif implicit none private @@ -32,53 +30,22 @@ pure function subject() result(test_subject) test_subject = "The prif_co_min 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_min_test_t) prif_co_min_test test_results = prif_co_min_test%run([ & - test_description_t("computing element-wise minima for integer(c_int32_t) scalars", check_32_bit_integer) & - ,test_description_t("computing element-wise minima for a 1D default integer array", check_default_integer) & - ,test_description_t("computing element-wise minima for a 1D integer(c_int8t) array", check_8_bit_integer) & - ,test_description_t("computing element-wise minima for a 1D integer(c_int16_t) array", check_16_bit_integer) & - ,test_description_t("computing element-wise minima for a 1D integer(c_int64_t) array", check_64_bit_integer) & - ,test_description_t("computing element-wise minima for a 2D real(c_float) array", check_32_bit_real) & - ,test_description_t("computing element-wise minima for a 1D real(c_double) array", check_64_bit_real) & - ,test_description_t("computing element-wise minima for a character scalar", check_character) & + test_description_t("computing element-wise minima for integer(c_int32_t) scalars", usher(check_32_bit_integer)) & + ,test_description_t("computing element-wise minima for a 1D default integer array", usher(check_default_integer)) & + ,test_description_t("computing element-wise minima for a 1D integer(c_int8t) array", usher(check_8_bit_integer)) & + ,test_description_t("computing element-wise minima for a 1D integer(c_int16_t) array", usher(check_16_bit_integer)) & + ,test_description_t("computing element-wise minima for a 1D integer(c_int64_t) array", usher(check_64_bit_integer)) & + ,test_description_t("computing element-wise minima for a 2D real(c_float) array", usher(check_32_bit_real)) & + ,test_description_t("computing element-wise minima for a 1D real(c_double) array", usher(check_64_bit_real)) & + ,test_description_t("computing element-wise minima for a character scalar", usher(check_character)) & ]) end function -#else - - function results() result(test_results) - type(test_result_t), allocatable :: test_results(:) - type(prif_co_min_test_t) prif_co_min_test - procedure(diagnosis_function_i), pointer :: & - check_32_bit_integer_ptr => check_32_bit_integer & - ,check_default_integer_ptr => check_default_integer & - ,check_8_bit_integer_ptr => check_8_bit_integer & - ,check_16_bit_integer_ptr => check_16_bit_integer & - ,check_64_bit_integer_ptr => check_64_bit_integer & - ,check_32_bit_real_ptr => check_32_bit_real & - ,check_64_bit_real_ptr => check_64_bit_real & - ,check_character_ptr => check_character - - test_results = prif_co_min_test%run([ & - test_description_t("computing element-wise minima for integer(c_int32_t) scalars", check_32_bit_integer_ptr) & - ,test_description_t("computing element-wise minima for a 1D default integer array", check_default_integer_ptr) & - ,test_description_t("computing element-wise minima for a 1D integer(c_int8t) array", check_8_bit_integer_ptr) & - ,test_description_t("computing element-wise minima for a 1D integer(c_int16_t) array", check_16_bit_integer_ptr) & - ,test_description_t("computing element-wise minima for a 1D integer(c_int64_t) array", check_64_bit_integer_ptr) & - ,test_description_t("computing element-wise minima for a 2D real(c_float) array", check_32_bit_real_ptr) & - ,test_description_t("computing element-wise minima for a 1D real(c_double) array", check_64_bit_real_ptr) & - ,test_description_t("computing element-wise minima for a character scalar", check_character_ptr) & - ]) - end function - -#endif - function check_default_integer() result(test_diagnosis) type(test_diagnosis_t) test_diagnosis diff --git a/test/prif_co_reduce_test.F90 b/test/prif_co_reduce_test.F90 index 5c4e2fd0..c4111009 100644 --- a/test/prif_co_reduce_test.F90 +++ b/test/prif_co_reduce_test.F90 @@ -10,13 +10,11 @@ module prif_co_reduce_test_m ,operator(.equalsExpected.) & ,operator(.expect.) & ,operator(.within.) & + ,usher & ,test_description_t & ,test_diagnosis_t & ,test_result_t & ,test_t -#if ! HAVE_PROCEDURAL_ACTUAL_FOR_POINTER_DUMMY - use julienne_m, only : diagnosis_function_i -#endif implicit none private @@ -52,46 +50,19 @@ pure function subject() result(test_subject) test_subject = "The prif_co_reduce subroutine" end function -#if HAVE_PROCEDURAL_ACTUAL_FOR_POINTER_DUMMY - - function results() result(test_results) - type(test_result_t), allocatable :: test_results(:) - type(prif_co_reduce_test_t) prif_co_reduce_test - - test_results = prif_co_reduce_test%run([ & - test_description_t("performing a logical .and. reduction", check_logical) & - ,test_description_t("performing a derived type reduction", check_derived_type_reduction) & -#if HAVE_PARAM_DERIVED - ,test_description_t("performing a parameterized derived type reduction", check_type_parameter_reduction) & -#endif - ]) - end function - -#else - function results() result(test_results) type(test_result_t), allocatable :: test_results(:) type(prif_co_reduce_test_t) prif_co_reduce_test - procedure(diagnosis_function_i), pointer :: & - check_logical_ptr => check_logical & - ,check_derived_type_reduction_ptr => check_derived_type_reduction -#if HAVE_PARAM_DERIVED - procedure(diagnosis_function_i), pointer :: check_type_parameter_reduction_ptr => check_type_parameter_reduction -#endif test_results = prif_co_reduce_test%run([ & - test_description_t("performing a logical .and. reduction", check_logical_ptr) & - ,test_description_t("performing a derived type reduction", check_derived_type_reduction_ptr) & + test_description_t("performing a logical .and. reduction", usher(check_logical)) & + ,test_description_t("performing a derived type reduction", usher(check_derived_type_reduction)) & #if HAVE_PARAM_DERIVED - ,test_description_t("performing a parameterized derived type reduction", check_type_parameter_reduction_ptr) & + ,test_description_t("performing a parameterized derived type reduction", usher(check_type_parameter_reduction)) & #endif ]) end function - -#endif - - function check_logical() result(test_diagnosis) type(test_diagnosis_t) test_diagnosis logical :: val diff --git a/test/prif_co_sum_test.F90 b/test/prif_co_sum_test.F90 index 1fb52fd5..0d468412 100644 --- a/test/prif_co_sum_test.F90 +++ b/test/prif_co_sum_test.F90 @@ -9,13 +9,11 @@ module prif_co_sum_test_m ,operator(.approximates.) & ,operator(.equalsExpected.) & ,operator(.within.) & + ,usher & ,test_description_t & ,test_diagnosis_t & ,test_result_t & ,test_t -#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - use julienne_m, only : diagnosis_function_i -#endif implicit none private @@ -34,56 +32,23 @@ pure function subject() result(test_subject) test_subject = "The prif_co_sum 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_sum_test_t) prif_co_sum_test test_results = prif_co_sum_test%run([ & - test_description_t("computing the element-wise sum of a 1D default integer array", check_default_integer) & - ,test_description_t("computing the element-wise sum of a 1D 8-bit integer(c_int8_t) array", check_8_bit_integer) & - ,test_description_t("computing the element-wise sum of a 1D 16-bit integer(c_int16_t) array", check_16_bit_integer) & - ,test_description_t("computing the element-wise sum of integer(c_int32_t) scalars", check_32_bit_integer) & - ,test_description_t("computing the element-wise sum of a 1D 64-bit integer(c_int64_t) array", check_64_bit_integer) & - ,test_description_t("computing the element-wise sum of a 2D 32-bit real(c_float) array", check_32_bit_real) & - ,test_description_t("computing the element-wise sum of a 1D 64-bit real(c_double) array", check_64_bit_real) & - ,test_description_t("computing the element-wise sum of a 2D complex(c_float) array", check_32_bit_complex) & - ,test_description_t("computing the element-wise sum of a 1D complex(c_double) array", check_64_bit_complex) & + test_description_t("computing the element-wise sum of a 1D default integer array", usher(check_default_integer)) & + ,test_description_t("computing the element-wise sum of a 1D 8-bit integer(c_int8_t) array", usher(check_8_bit_integer)) & + ,test_description_t("computing the element-wise sum of a 1D 16-bit integer(c_int16_t) array", usher(check_16_bit_integer)) & + ,test_description_t("computing the element-wise sum of integer(c_int32_t) scalars", usher(check_32_bit_integer)) & + ,test_description_t("computing the element-wise sum of a 1D 64-bit integer(c_int64_t) array", usher(check_64_bit_integer)) & + ,test_description_t("computing the element-wise sum of a 2D 32-bit real(c_float) array", usher(check_32_bit_real)) & + ,test_description_t("computing the element-wise sum of a 1D 64-bit real(c_double) array", usher(check_64_bit_real)) & + ,test_description_t("computing the element-wise sum of a 2D complex(c_float) array", usher(check_32_bit_complex)) & + ,test_description_t("computing the element-wise sum of a 1D complex(c_double) array", usher(check_64_bit_complex)) & ]) end function -#else - - function results() result(test_results) - type(test_result_t), allocatable :: test_results(:) - type(prif_co_sum_test_t) prif_co_sum_test - procedure(diagnosis_function_i), pointer :: & - check_default_integer_ptr => check_default_integer & - ,check_8_bit_integer_ptr => check_8_bit_integer & - ,check_16_bit_integer_ptr => check_16_bit_integer & - ,check_32_bit_integer_ptr => check_32_bit_integer & - ,check_64_bit_integer_ptr => check_64_bit_integer & - ,check_32_bit_real_ptr => check_32_bit_real & - ,check_64_bit_real_ptr => check_64_bit_real & - ,check_32_bit_complex_ptr => check_32_bit_complex & - ,check_64_bit_complex_ptr => check_64_bit_complex - - test_results = prif_co_sum_test%run([ & - test_description_t("computing the element-wise sum of a 1D default integer array", check_default_integer_ptr) & - ,test_description_t("computing the element-wise sum of a 1D 8-bit integer(c_int8_t) array", check_8_bit_integer_ptr) & - ,test_description_t("computing the element-wise sum of a 1D 16-bit integer(c_int16_t) array", check_16_bit_integer_ptr) & - ,test_description_t("computing the element-wise sum of integer(c_int32_t) scalars", check_32_bit_integer_ptr) & - ,test_description_t("computing the element-wise sum of a 1D 64-bit integer(c_int64_t) array", check_64_bit_integer_ptr) & - ,test_description_t("computing the element-wise sum of a 2D 32-bit real(c_float) array", check_32_bit_real_ptr) & - ,test_description_t("computing the element-wise sum of a 1D 64-bit real(c_double) array", check_64_bit_real_ptr) & - ,test_description_t("computing the element-wise sum of a 2D complex(c_float) array", check_32_bit_complex_ptr) & - ,test_description_t("computing the element-wise sum of a 1D complex(c_double) array", check_64_bit_complex_ptr) & - ]) - end function - -#endif - function check_default_integer() result(test_diagnosis) type(test_diagnosis_t) test_diagnosis diff --git a/test/prif_coarray_inquiry_test.F90 b/test/prif_coarray_inquiry_test.F90 index 097430a8..00c0ed97 100644 --- a/test/prif_coarray_inquiry_test.F90 +++ b/test/prif_coarray_inquiry_test.F90 @@ -14,13 +14,11 @@ module prif_coarray_inquiry_test_m ,operator(.also.) & ,operator(.equalsExpected.) & ,operator(.expect.) & + ,usher & ,test_description_t & ,test_diagnosis_t & ,test_result_t & ,test_t -#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - use julienne_m, only : diagnosis_function_i -#endif use iso_c_binding, only: & c_ptr, c_null_ptr, c_int64_t, c_int, c_size_t, c_null_funptr, c_associated @@ -41,35 +39,16 @@ pure function subject() result(test_subject) test_subject = "The PRIF coarray inquiry subroutines" end function -#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - function results() result(test_results) type(test_result_t), allocatable :: test_results(:) type(prif_coarray_inquiry_test_t) prif_coarray_inquiry_test test_results = prif_coarray_inquiry_test%run([ & - test_description_t("preserving the prif_local_data_pointer for an allocated coarray", check_prif_local_data_pointer) & - ,test_description_t("checking passed cobounds", check_cobounds) & + test_description_t("preserving the prif_local_data_pointer for an allocated coarray", usher(check_prif_local_data_pointer)) & + ,test_description_t("checking passed cobounds", usher(check_cobounds)) & ]) end function -#else - - function results() result(test_results) - type(test_result_t), allocatable :: test_results(:) - type(prif_coarray_inquiry_test_t) prif_coarray_inquiry_test - procedure(diagnosis_function_i), pointer :: & - check_prif_local_data_pointer_ptr => check_prif_local_data_pointer & - ,check_cobounds_ptr => check_cobounds - - test_results = prif_coarray_inquiry_test%run([ & - test_description_t("preserving the prif_local_data_pointer for an allocated coarray", check_prif_local_data_pointer_ptr) & - ,test_description_t("checking passed cobounds", check_cobounds_ptr) & - ]) - end function - -#endif - function check_prif_local_data_pointer() result(test_diagnosis) type(test_diagnosis_t) test_diagnosis diff --git a/test/prif_image_queries_test.F90 b/test/prif_image_queries_test.F90 index 382f3c02..46efe85a 100644 --- a/test/prif_image_queries_test.F90 +++ b/test/prif_image_queries_test.F90 @@ -12,13 +12,11 @@ module prif_image_queries_test_m ,operator(.isAtMost.) & ,operator(.lessThan.) & ,operator(.expect.) & + ,usher & ,test_description_t & ,test_diagnosis_t & ,test_result_t & ,test_t -#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - use julienne_m, only: diagnosis_function_i -#endif implicit none private @@ -37,38 +35,17 @@ pure function subject() result(test_subject) test_subject = "PRIF image queries" end function -#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - function results() result(test_results) type(test_result_t), allocatable :: test_results(:) type(prif_image_queries_test_t) prif_image_queries_test test_results = prif_image_queries_test%run([ & - test_description_t("providing valid prif_image_status()", check_image_status) & - ,test_description_t("providing valid prif_stopped_images()", check_stopped_images) & - ,test_description_t("providing valid prif_failed_images()", check_failed_images) & + test_description_t("providing valid prif_image_status()", usher(check_image_status)) & + ,test_description_t("providing valid prif_stopped_images()", usher(check_stopped_images)) & + ,test_description_t("providing valid prif_failed_images()", usher(check_failed_images)) & ]) end function -#else - - function results() result(test_results) - type(test_result_t), allocatable :: test_results(:) - type(prif_image_queries_test_t) prif_image_queries_test - procedure(diagnosis_function_i), pointer :: & - check_image_status_ptr => check_image_status & - ,check_stopped_images_ptr => check_stopped_images & - ,check_failed_images_ptr => check_failed_images - - test_results = prif_image_queries_test%run([ & - test_description_t("providing valid prif_image_status()", check_image_status_ptr) & - ,test_description_t("providing valid prif_stopped_images()", check_stopped_images_ptr) & - ,test_description_t("providing valid prif_failed_images()", check_failed_images_ptr) & - ]) - end function - -#endif - function check_image_status() result(test_diagnosis) type(test_diagnosis_t) :: test_diagnosis integer(c_int) :: image_status diff --git a/test/prif_init_test.F90 b/test/prif_init_test.F90 index 5933279f..36b7ef95 100644 --- a/test/prif_init_test.F90 +++ b/test/prif_init_test.F90 @@ -2,10 +2,7 @@ module prif_init_test_m use prif, only : prif_init, PRIF_STAT_ALREADY_INIT - use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, operator(.equalsExpected.) -#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - use julienne_m, only: diagnosis_function_i -#endif + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, operator(.equalsExpected.), usher implicit none private @@ -24,34 +21,16 @@ pure function subject() result(test_subject) test_subject = "The prif_init subroutine" end function -#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - - function results() result(test_results) - type(test_result_t), allocatable :: test_results(:) - type(prif_init_test_t) prif_init_test - - test_results = prif_init_test%run([ & - test_description_t("completing successfully", check_caffeination) & - ,test_description_t("returning PRIF_STAT_ALREADY_INIT on a subsequent call ", check_subsequent_prif_init_call) & - ]) - end function - -#else - function results() result(test_results) type(test_result_t), allocatable :: test_results(:) type(prif_init_test_t) prif_init_test - procedure(diagnosis_function_i), pointer :: & - check_caffeination_ptr => check_caffeination & - ,check_subsequent_prif_init_call_ptr => check_subsequent_prif_init_call test_results = prif_init_test%run([ & - test_description_t("completing successfully", check_caffeination_ptr) & - ,test_description_t("returning PRIF_STAT_ALREADY_INIT on a subsequent call ", check_subsequent_prif_init_call_ptr) & + test_description_t("completing successfully", usher(check_caffeination)) & + ,test_description_t("returning PRIF_STAT_ALREADY_INIT on a subsequent call ", usher(check_subsequent_prif_init_call)) & ]) end function -#endif function check_caffeination() result(test_diagnosis) ! this test needs to run very early at startup, so we memoize the result diff --git a/test/prif_num_images_test.F90 b/test/prif_num_images_test.F90 index c62856a0..a408bdac 100644 --- a/test/prif_num_images_test.F90 +++ b/test/prif_num_images_test.F90 @@ -5,13 +5,11 @@ module prif_num_images_test_m use julienne_m, only: & operator(//) & ,operator(.isAtLeast.) & + ,usher & ,test_description_t & ,test_diagnosis_t & ,test_result_t & ,test_t -#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - use julienne_m, only: diagnosis_function_i -#endif implicit none private @@ -30,31 +28,15 @@ pure function subject() result(test_subject) test_subject = "The prif_num_images function" end function -#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - - function results() result(test_results) - type(test_result_t), allocatable :: test_results(:) - type(prif_num_images_test_t) prif_num_images_test - - test_results = prif_num_images_test%run([ & - test_description_t("returning a valid number of images when invoked with no arguments", check_num_images_valid) & - ]) - end function - -#else - function results() result(test_results) type(test_result_t), allocatable :: test_results(:) type(prif_num_images_test_t) prif_num_images_test - procedure(diagnosis_function_i), pointer :: & - check_num_images_valid_ptr => check_num_images_valid test_results = prif_num_images_test%run([ & - test_description_t("returning a valid number of images when invoked with no arguments", check_num_images_valid_ptr) & + test_description_t("returning a valid number of images when invoked with no arguments", usher(check_num_images_valid)) & ]) end function -#endif function check_num_images_valid() result(test_diagnosis) type(test_diagnosis_t) test_diagnosis diff --git a/test/prif_sync_images_test.F90 b/test/prif_sync_images_test.F90 index d20d8c4d..536211ce 100644 --- a/test/prif_sync_images_test.F90 +++ b/test/prif_sync_images_test.F90 @@ -3,11 +3,7 @@ module prif_sync_images_test_m use iso_c_binding, only: c_int use prif, only : prif_sync_images, prif_this_image_no_coarray, prif_num_images, prif_sync_all - use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, operator(.expect.) - -#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - use julienne_m, only: diagnosis_function_i -#endif + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, operator(.expect.), usher implicit none private @@ -28,38 +24,17 @@ pure function subject() result(test_subject) test_subject = "The prif_sync_images subroutine" end function -#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - - function results() result(test_results) - type(test_result_t), allocatable :: test_results(:) - type(prif_sync_images_test_t) prif_sync_images_test - - test_results = prif_sync_images_test%run([ & - test_description_t("synchronizing an image with itself", check_serial), & - test_description_t("synchronizing with a neighbor", check_neighbor), & - test_description_t("synchronizing every image with one image", check_hot) & - ]) - end function - -#else - function results() result(test_results) type(test_result_t), allocatable :: test_results(:) type(prif_sync_images_test_t) prif_sync_images_test - procedure(diagnosis_function_i), pointer :: & - check_serial_ptr => check_serial & - ,check_neighbor_ptr => check_neighbor & - ,check_hot_ptr => check_hot test_results = prif_sync_images_test%run([ & - test_description_t("synchronizing an image with itself", check_serial_ptr), & - test_description_t("synchronizing with a neighbor", check_neighbor_ptr), & - test_description_t("synchronizing every image with one image", check_hot_ptr) & + test_description_t("synchronizing an image with itself", usher(check_serial)), & + test_description_t("synchronizing with a neighbor", usher(check_neighbor)), & + test_description_t("synchronizing every image with one image", usher(check_hot)) & ]) end function -#endif - function check_serial() result(test_diagnosis) type(test_diagnosis_t) test_diagnosis integer(c_int) :: me diff --git a/test/prif_this_image_test.F90 b/test/prif_this_image_test.F90 index 44dc8361..62cb486e 100644 --- a/test/prif_this_image_test.F90 +++ b/test/prif_this_image_test.F90 @@ -6,13 +6,11 @@ module prif_this_image_no_coarray_test_m operator(//) & ,operator(.all.) & ,operator(.equalsExpected.) & + ,usher & ,test_description_t & ,test_diagnosis_t & ,test_result_t & ,test_t -#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - use julienne_m, only: diagnosis_function_i -#endif implicit none private @@ -30,32 +28,15 @@ pure function subject() result(test_subject) test_subject = "The prif_this_image_no_coarray subroutine" end function -#if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY - function results() result(test_results) type(test_result_t), allocatable :: test_results(:) type(prif_this_image_no_coarray_test_t) prif_this_image_no_coarray_test test_results = prif_this_image_no_coarray_test%run([ & - test_description_t("returning a unique member of {1,...,num_images()} when called without arguments", check_this_image_set) & + test_description_t("returning a unique member of {1,...,num_images()} when called without arguments", usher(check_this_image_set)) & ]) end function -#else - - function results() result(test_results) - type(test_result_t), allocatable :: test_results(:) - type(prif_this_image_no_coarray_test_t) prif_this_image_no_coarray_test - procedure(diagnosis_function_i), pointer :: & - check_this_image_set_ptr => check_this_image_set - - test_results = prif_this_image_no_coarray_test%run([ & - test_description_t("returning a unique member of {1,...,num_images()} when called without arguments", check_this_image_set_ptr) & - ]) - end function - -#endif - function check_this_image_set() result(test_diagnosis) type(test_diagnosis_t) :: test_diagnosis integer, allocatable :: image_numbers(:) From 995422ea58b0f9f7d1a45434180c0b7f197da765 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 7 Nov 2025 21:06:59 -0800 Subject: [PATCH 04/13] prif_init_test: Fix for flang-latest with native PRIF --- test/prif_init_test.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/prif_init_test.F90 b/test/prif_init_test.F90 index 36b7ef95..617ce6e1 100644 --- a/test/prif_init_test.F90 +++ b/test/prif_init_test.F90 @@ -42,7 +42,11 @@ function check_caffeination() result(test_diagnosis) first_pass = .false. write_memo: & block +#if HAVE_MULTI_IMAGE + integer, parameter :: successful_initiation = PRIF_STAT_ALREADY_INIT +#else integer, parameter :: successful_initiation = 0 +#endif integer init_exit_code call prif_init(init_exit_code) From 871dd263004944d34431725653621acbd232bf02 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 7 Nov 2025 21:49:19 -0800 Subject: [PATCH 05/13] CI: Activate Julienne's multi-image support for flang-latest --- .github/workflows/build.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 844b980f..07776ee8 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -152,7 +152,7 @@ jobs: echo "GASNET_SUPERNODE_MAXSIZE=1" >> "$GITHUB_ENV" ; \ fi if (( ${{ matrix.native_multi_image }} )); then \ - echo "FFLAGS=$FFLAGS -DHAVE_MULTI_IMAGE" >> "$GITHUB_ENV" ; \ + echo "FFLAGS=$FFLAGS -DHAVE_MULTI_IMAGE -DHAVE_MULTI_IMAGE_SUPPORT" >> "$GITHUB_ENV" ; \ fi From 002a0a60afc49f8931cb30f928bfa424e3446c6e Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 14 Nov 2025 20:15:10 -0800 Subject: [PATCH 06/13] Partially revert changes involving include/language-support.F90 This header is no longer relevant to the test code --- include/language-support.F90 | 6 ++---- test/prif_co_broadcast_test.F90 | 2 -- test/prif_co_max_test.F90 | 2 -- test/prif_co_min_test.F90 | 2 -- test/prif_co_reduce_test.F90 | 2 -- test/prif_co_sum_test.F90 | 2 -- test/prif_coarray_inquiry_test.F90 | 2 -- test/prif_image_queries_test.F90 | 2 -- test/prif_init_test.F90 | 2 -- test/prif_num_images_test.F90 | 2 -- test/prif_sync_images_test.F90 | 2 -- test/prif_this_image_test.F90 | 2 -- 12 files changed, 2 insertions(+), 26 deletions(-) diff --git a/include/language-support.F90 b/include/language-support.F90 index 37221610..e75b74cb 100644 --- a/include/language-support.F90 +++ b/include/language-support.F90 @@ -2,9 +2,7 @@ ! 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 +# define HAVE_GCC_VERSION (__GNUC__ * 10000 + __GNUC_MINOR__ * 100 + __GNUC_PATCHLEVEL__) #endif #ifndef HAVE_SELECTED_LOGICAL_KIND @@ -21,7 +19,7 @@ ! 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__ || (GCC_VERSION > 140200) +#if defined(_CRAYFTN) || defined(__INTEL_COMPILER) || defined(NAGFOR) || defined(__flang__) || (HAVE_GCC_VERSION > 140200) # define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 1 #else # define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 0 diff --git a/test/prif_co_broadcast_test.F90 b/test/prif_co_broadcast_test.F90 index 8738e3ae..415bdb7a 100644 --- a/test/prif_co_broadcast_test.F90 +++ b/test/prif_co_broadcast_test.F90 @@ -1,5 +1,3 @@ -#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 julienne_m, only : & diff --git a/test/prif_co_max_test.F90 b/test/prif_co_max_test.F90 index f6ec5e28..4c2eddc6 100644 --- a/test/prif_co_max_test.F90 +++ b/test/prif_co_max_test.F90 @@ -1,5 +1,3 @@ -#include "language-support.F90" - module prif_co_max_test_m use iso_c_binding, only: c_int8_t, c_int16_t, c_int32_t, c_int64_t, c_float, c_double use prif, only : prif_co_max, prif_co_max_character, prif_this_image_no_coarray, prif_num_images diff --git a/test/prif_co_min_test.F90 b/test/prif_co_min_test.F90 index 603b55e8..b8f292d0 100644 --- a/test/prif_co_min_test.F90 +++ b/test/prif_co_min_test.F90 @@ -1,5 +1,3 @@ -#include "language-support.F90" - module prif_co_min_test_m use iso_c_binding, only: c_int8_t, c_int16_t, c_int32_t, c_int64_t, c_float, c_double use prif, only : prif_co_min, prif_co_min_character, prif_this_image_no_coarray, prif_num_images diff --git a/test/prif_co_reduce_test.F90 b/test/prif_co_reduce_test.F90 index c4111009..d299209b 100644 --- a/test/prif_co_reduce_test.F90 +++ b/test/prif_co_reduce_test.F90 @@ -1,5 +1,3 @@ -#include "language-support.F90" - module prif_co_reduce_test_m use iso_c_binding, only: c_ptr, c_funptr, c_size_t, c_f_pointer, c_f_procpointer, c_funloc, c_loc, c_null_ptr use prif, only : prif_co_reduce, prif_num_images, prif_this_image_no_coarray, prif_operation_wrapper_interface diff --git a/test/prif_co_sum_test.F90 b/test/prif_co_sum_test.F90 index 0d468412..b66d9037 100644 --- a/test/prif_co_sum_test.F90 +++ b/test/prif_co_sum_test.F90 @@ -1,5 +1,3 @@ -#include "language-support.F90" - module prif_co_sum_test_m use iso_c_binding, only: c_int8_t, c_int16_t, c_int32_t, c_int64_t, c_float, c_double use prif, only : prif_co_sum, prif_num_images, prif_this_image_no_coarray diff --git a/test/prif_coarray_inquiry_test.F90 b/test/prif_coarray_inquiry_test.F90 index 00c0ed97..4ad9f2df 100644 --- a/test/prif_coarray_inquiry_test.F90 +++ b/test/prif_coarray_inquiry_test.F90 @@ -1,5 +1,3 @@ -#include "language-support.F90" - module prif_coarray_inquiry_test_m use prif, only : & prif_allocate_coarray, prif_deallocate_coarray, & diff --git a/test/prif_image_queries_test.F90 b/test/prif_image_queries_test.F90 index 46efe85a..60f67c15 100644 --- a/test/prif_image_queries_test.F90 +++ b/test/prif_image_queries_test.F90 @@ -1,5 +1,3 @@ -#include "language-support.F90" - module prif_image_queries_test_m use iso_c_binding, only: c_int use prif, only : prif_image_status, prif_stopped_images, prif_failed_images, PRIF_STAT_FAILED_IMAGE, PRIF_STAT_STOPPED_IMAGE diff --git a/test/prif_init_test.F90 b/test/prif_init_test.F90 index 617ce6e1..42e8beba 100644 --- a/test/prif_init_test.F90 +++ b/test/prif_init_test.F90 @@ -1,5 +1,3 @@ -#include "language-support.F90" - module prif_init_test_m use prif, only : prif_init, PRIF_STAT_ALREADY_INIT use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, operator(.equalsExpected.), usher diff --git a/test/prif_num_images_test.F90 b/test/prif_num_images_test.F90 index a408bdac..c520a32d 100644 --- a/test/prif_num_images_test.F90 +++ b/test/prif_num_images_test.F90 @@ -1,5 +1,3 @@ -#include "language-support.F90" - module prif_num_images_test_m use prif, only : prif_num_images use julienne_m, only: & diff --git a/test/prif_sync_images_test.F90 b/test/prif_sync_images_test.F90 index 536211ce..a4704353 100644 --- a/test/prif_sync_images_test.F90 +++ b/test/prif_sync_images_test.F90 @@ -1,5 +1,3 @@ -#include "language-support.F90" - module prif_sync_images_test_m use iso_c_binding, only: c_int use prif, only : prif_sync_images, prif_this_image_no_coarray, prif_num_images, prif_sync_all diff --git a/test/prif_this_image_test.F90 b/test/prif_this_image_test.F90 index 62cb486e..cb86ba44 100644 --- a/test/prif_this_image_test.F90 +++ b/test/prif_this_image_test.F90 @@ -1,5 +1,3 @@ -#include "language-support.F90" - module prif_this_image_no_coarray_test_m use prif, only : prif_this_image_no_coarray, prif_num_images, prif_co_sum use julienne_m, only: & From f31999b510efa7ccca8cd22f7efde8e3ff16bc87 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 14 Nov 2025 20:36:32 -0800 Subject: [PATCH 07/13] Simplify subject() strings Minimize extraneous verbiage in subject() strings to make the output easier to visually skim None of the PRIF procedures are functions, and the function/subroutine distinction is irrelevant in test output --- test/prif_co_broadcast_test.F90 | 2 +- test/prif_co_max_test.F90 | 2 +- test/prif_co_min_test.F90 | 2 +- test/prif_co_reduce_test.F90 | 2 +- test/prif_co_sum_test.F90 | 2 +- test/prif_coarray_inquiry_test.F90 | 2 +- test/prif_image_queries_test.F90 | 2 +- test/prif_init_test.F90 | 2 +- test/prif_num_images_test.F90 | 2 +- test/prif_sync_images_test.F90 | 2 +- test/prif_this_image_test.F90 | 2 +- 11 files changed, 11 insertions(+), 11 deletions(-) diff --git a/test/prif_co_broadcast_test.F90 b/test/prif_co_broadcast_test.F90 index 415bdb7a..9d6a02e2 100644 --- a/test/prif_co_broadcast_test.F90 +++ b/test/prif_co_broadcast_test.F90 @@ -35,7 +35,7 @@ module prif_co_broadcast_test_m pure function subject() result(test_subject) character(len=:), allocatable :: test_subject - test_subject = "The prif_co_broadcast subroutine" + test_subject = "prif_co_broadcast" end function function results() result(test_results) diff --git a/test/prif_co_max_test.F90 b/test/prif_co_max_test.F90 index 4c2eddc6..a739ac2b 100644 --- a/test/prif_co_max_test.F90 +++ b/test/prif_co_max_test.F90 @@ -27,7 +27,7 @@ module prif_co_max_test_m pure function subject() result(test_subject) character(len=:), allocatable :: test_subject - test_subject = "The prif_co_max subroutine" + test_subject = "prif_co_max" end function function results() result(test_results) diff --git a/test/prif_co_min_test.F90 b/test/prif_co_min_test.F90 index b8f292d0..d014c4f2 100644 --- a/test/prif_co_min_test.F90 +++ b/test/prif_co_min_test.F90 @@ -25,7 +25,7 @@ module prif_co_min_test_m contains pure function subject() result(test_subject) character(len=:), allocatable :: test_subject - test_subject = "The prif_co_min subroutine" + test_subject = "prif_co_min" end function function results() result(test_results) diff --git a/test/prif_co_reduce_test.F90 b/test/prif_co_reduce_test.F90 index d299209b..f63a097b 100644 --- a/test/prif_co_reduce_test.F90 +++ b/test/prif_co_reduce_test.F90 @@ -45,7 +45,7 @@ module prif_co_reduce_test_m pure function subject() result(test_subject) character(len=:), allocatable :: test_subject - test_subject = "The prif_co_reduce subroutine" + test_subject = "prif_co_reduce" end function function results() result(test_results) diff --git a/test/prif_co_sum_test.F90 b/test/prif_co_sum_test.F90 index b66d9037..e95de299 100644 --- a/test/prif_co_sum_test.F90 +++ b/test/prif_co_sum_test.F90 @@ -27,7 +27,7 @@ module prif_co_sum_test_m pure function subject() result(test_subject) character(len=:), allocatable :: test_subject - test_subject = "The prif_co_sum subroutine" + test_subject = "prif_co_sum" end function function results() result(test_results) diff --git a/test/prif_coarray_inquiry_test.F90 b/test/prif_coarray_inquiry_test.F90 index 4ad9f2df..5be8aac1 100644 --- a/test/prif_coarray_inquiry_test.F90 +++ b/test/prif_coarray_inquiry_test.F90 @@ -34,7 +34,7 @@ module prif_coarray_inquiry_test_m pure function subject() result(test_subject) character(len=:), allocatable :: test_subject - test_subject = "The PRIF coarray inquiry subroutines" + test_subject = "PRIF coarray inquiry procedures" end function function results() result(test_results) diff --git a/test/prif_image_queries_test.F90 b/test/prif_image_queries_test.F90 index 60f67c15..3ab99499 100644 --- a/test/prif_image_queries_test.F90 +++ b/test/prif_image_queries_test.F90 @@ -30,7 +30,7 @@ module prif_image_queries_test_m pure function subject() result(test_subject) character(len=:), allocatable :: test_subject - test_subject = "PRIF image queries" + test_subject = "PRIF image query procedures" end function function results() result(test_results) diff --git a/test/prif_init_test.F90 b/test/prif_init_test.F90 index 42e8beba..49ad33d3 100644 --- a/test/prif_init_test.F90 +++ b/test/prif_init_test.F90 @@ -16,7 +16,7 @@ module prif_init_test_m pure function subject() result(test_subject) character(len=:), allocatable :: test_subject - test_subject = "The prif_init subroutine" + test_subject = "prif_init" end function function results() result(test_results) diff --git a/test/prif_num_images_test.F90 b/test/prif_num_images_test.F90 index c520a32d..7baec653 100644 --- a/test/prif_num_images_test.F90 +++ b/test/prif_num_images_test.F90 @@ -23,7 +23,7 @@ module prif_num_images_test_m pure function subject() result(test_subject) character(len=:), allocatable :: test_subject - test_subject = "The prif_num_images function" + test_subject = "prif_num_images" end function function results() result(test_results) diff --git a/test/prif_sync_images_test.F90 b/test/prif_sync_images_test.F90 index a4704353..66ec85ad 100644 --- a/test/prif_sync_images_test.F90 +++ b/test/prif_sync_images_test.F90 @@ -19,7 +19,7 @@ module prif_sync_images_test_m pure function subject() result(test_subject) character(len=:), allocatable :: test_subject - test_subject = "The prif_sync_images subroutine" + test_subject = "prif_sync_images" end function function results() result(test_results) diff --git a/test/prif_this_image_test.F90 b/test/prif_this_image_test.F90 index cb86ba44..6494d9bf 100644 --- a/test/prif_this_image_test.F90 +++ b/test/prif_this_image_test.F90 @@ -23,7 +23,7 @@ module prif_this_image_no_coarray_test_m contains pure function subject() result(test_subject) character(len=:), allocatable :: test_subject - test_subject = "The prif_this_image_no_coarray subroutine" + test_subject = "prif_this_image_no_coarray" end function function results() result(test_results) From 24f25123495d80fd9bdbb390e9a7287e4ef831a8 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 14 Nov 2025 21:03:33 -0800 Subject: [PATCH 08/13] Cosmetic: Rename test_diagnosis variables to diag, ... This abbreviation helps with readability, especially for the incremental test idiom (ie. `test_diagnosis = test_diagnosis .also. `). Restore line break conventions used in the incremental test idiom, which emphasizes readability of the relevant expression. Replace `.expect. .true.` with the shorter idiom in newer Julienne --- test/prif_co_broadcast_test.F90 | 12 +++---- test/prif_co_max_test.F90 | 48 +++++++++++++------------- test/prif_co_min_test.F90 | 48 +++++++++++++------------- test/prif_co_reduce_test.F90 | 23 +++++++------ test/prif_co_sum_test.F90 | 54 +++++++++++++++--------------- test/prif_coarray_inquiry_test.F90 | 39 ++++++++++++--------- test/prif_image_queries_test.F90 | 24 ++++++------- test/prif_init_test.F90 | 12 +++---- test/prif_num_images_test.F90 | 6 ++-- test/prif_sync_images_test.F90 | 18 +++++----- test/prif_this_image_test.F90 | 6 ++-- 11 files changed, 151 insertions(+), 139 deletions(-) diff --git a/test/prif_co_broadcast_test.F90 b/test/prif_co_broadcast_test.F90 index 9d6a02e2..3ba12c5c 100644 --- a/test/prif_co_broadcast_test.F90 +++ b/test/prif_co_broadcast_test.F90 @@ -58,19 +58,19 @@ logical pure function equals(lhs, rhs) ]) end function - function broadcast_default_integer_scalar() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function broadcast_default_integer_scalar() result(diag) + type(test_diagnosis_t) :: diag 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) - test_diagnosis = iPhone .equalsExpected. source_value + diag = iPhone .equalsExpected. source_value end function - function broadcast_derived_type() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function broadcast_derived_type() result(diag) + type(test_diagnosis_t) :: diag type(object_t) object integer me, ni @@ -79,7 +79,7 @@ function broadcast_derived_type() result(test_diagnosis) 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.))) - test_diagnosis = .expect. (object == expected_object) // "co_broadcast derived type" + diag = .expect. (object == expected_object) // "co_broadcast derived type" end associate end function diff --git a/test/prif_co_max_test.F90 b/test/prif_co_max_test.F90 index a739ac2b..2abc8a6a 100644 --- a/test/prif_co_max_test.F90 +++ b/test/prif_co_max_test.F90 @@ -46,8 +46,8 @@ function results() result(test_results) ]) end function - function check_default_integer() result(test_diagnosis) - type(test_diagnosis_t) :: test_diagnosis + function check_default_integer() result(diag) + type(test_diagnosis_t) :: diag integer, parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) integer :: me, ni, i @@ -60,11 +60,11 @@ function check_default_integer() result(test_diagnosis) call prif_co_max(my_val) expected = maxval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_8_bit_integer() result(test_diagnosis) - type(test_diagnosis_t) :: test_diagnosis + function check_8_bit_integer() result(diag) + type(test_diagnosis_t) :: diag integer(c_int8_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int8_t), [2, 4]) integer :: me, ni, i @@ -77,11 +77,11 @@ function check_8_bit_integer() result(test_diagnosis) call prif_co_max(my_val) expected = maxval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_16_bit_integer() result(test_diagnosis) - type(test_diagnosis_t) :: test_diagnosis + function check_16_bit_integer() result(diag) + type(test_diagnosis_t) :: diag integer(c_int16_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int16_t), [2, 4]) integer :: me, ni, i @@ -94,11 +94,11 @@ function check_16_bit_integer() result(test_diagnosis) call prif_co_max(my_val) expected = maxval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_32_bit_integer() result(test_diagnosis) - type(test_diagnosis_t) :: test_diagnosis + function check_32_bit_integer() result(diag) + type(test_diagnosis_t) :: diag integer(c_int32_t), parameter :: values(*) = [1, -19, 5, 13, 11, 7, 17, 3] integer :: me, ni, i @@ -111,11 +111,11 @@ function check_32_bit_integer() result(test_diagnosis) call prif_co_max(my_val) expected = maxval([(values(mod(i-1,size(values))+1), i = 1, ni)]) - test_diagnosis = my_val .equalsExpected. expected + diag = my_val .equalsExpected. expected end function - function check_64_bit_integer() result(test_diagnosis) - type(test_diagnosis_t) :: test_diagnosis + function check_64_bit_integer() result(diag) + type(test_diagnosis_t) :: diag integer(c_int64_t), parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) integer :: me, ni, i @@ -128,11 +128,11 @@ function check_64_bit_integer() result(test_diagnosis) call prif_co_max(my_val) expected = maxval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_32_bit_real() result(test_diagnosis) - type(test_diagnosis_t) :: test_diagnosis + function check_32_bit_real() result(diag) + type(test_diagnosis_t) :: diag real(c_float), parameter :: values(*,*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2,2,2]) real(c_float), parameter :: tolerance = 0_c_float @@ -146,11 +146,11 @@ function check_32_bit_real() result(test_diagnosis) call prif_co_max(my_val) expected = maxval(reshape([(values(:,:,mod(i-1,size(values,3))+1), i = 1, ni)], [size(values,1), size(values,2), ni]), dim=3) - test_diagnosis = .all. (my_val .approximates. expected .within. tolerance) + diag = .all. (my_val .approximates. expected .within. tolerance) end function - function check_64_bit_real() result(test_diagnosis) - type(test_diagnosis_t) :: test_diagnosis + function check_64_bit_real() result(diag) + type(test_diagnosis_t) :: diag real(c_double), parameter :: values(*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2, 4]) real(c_double), parameter :: tolerance = 0_c_double @@ -164,11 +164,11 @@ function check_64_bit_real() result(test_diagnosis) call prif_co_max(my_val) expected = maxval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (my_val .approximates. expected .within. tolerance) + diag = .all. (my_val .approximates. expected .within. tolerance) end function - function check_character() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_character() result(diag) + type(test_diagnosis_t) :: diag character(len=*), parameter :: values(*) = & [ "To be ","or not " & , "to ","be. " & @@ -185,7 +185,7 @@ function check_character() result(test_diagnosis) ! issue #205: workaround flang optimizer bug with a temp associate(tmp => [(values(mod(i-1,size(values))+1), i = 1, ni)]) - test_diagnosis = my_val .equalsExpected. maxval(tmp) + diag = my_val .equalsExpected. maxval(tmp) end associate end function diff --git a/test/prif_co_min_test.F90 b/test/prif_co_min_test.F90 index d014c4f2..625c989a 100644 --- a/test/prif_co_min_test.F90 +++ b/test/prif_co_min_test.F90 @@ -44,8 +44,8 @@ function results() result(test_results) ]) end function - function check_default_integer() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_default_integer() result(diag) + type(test_diagnosis_t) :: diag integer, parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) integer, dimension(size(values,1)) :: my_val, expected @@ -58,11 +58,11 @@ function check_default_integer() result(test_diagnosis) call prif_co_min(my_val) expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_8_bit_integer() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_8_bit_integer() result(diag) + type(test_diagnosis_t) :: diag integer(c_int8_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int8_t), [2, 4]) integer :: me, ni, i @@ -75,11 +75,11 @@ function check_8_bit_integer() result(test_diagnosis) call prif_co_min(my_val) expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_16_bit_integer() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_16_bit_integer() result(diag) + type(test_diagnosis_t) :: diag integer(c_int16_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int16_t), [2, 4]) integer :: me, ni, i @@ -92,11 +92,11 @@ function check_16_bit_integer() result(test_diagnosis) call prif_co_min(my_val) expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_32_bit_integer() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_32_bit_integer() result(diag) + type(test_diagnosis_t) :: diag integer(c_int32_t), parameter :: values(*) = [1, -19, 5, 13, 11, 7, 17, 3] integer :: me, ni, i @@ -109,11 +109,11 @@ function check_32_bit_integer() result(test_diagnosis) call prif_co_min(my_val) expected = minval([(values(mod(i-1,size(values))+1), i = 1, ni)]) - test_diagnosis = int(my_val) .equalsExpected. int(expected) + diag = int(my_val) .equalsExpected. int(expected) end function - function check_64_bit_integer() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_64_bit_integer() result(diag) + type(test_diagnosis_t) :: diag integer(c_int64_t), parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) integer :: me, ni, i @@ -126,11 +126,11 @@ function check_64_bit_integer() result(test_diagnosis) call prif_co_min(my_val) expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_32_bit_real() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_32_bit_real() result(diag) + type(test_diagnosis_t) :: diag real(c_float), parameter :: values(*,*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2,2,2]) real(c_double), parameter :: tolerance = 0_c_double @@ -144,11 +144,11 @@ function check_32_bit_real() result(test_diagnosis) call prif_co_min(my_val) expected = minval(reshape([(values(:,:,mod(i-1,size(values,3))+1), i = 1, ni)], [size(values,1), size(values,2), ni]), dim=3) - test_diagnosis = .all. (real(expected,kind=c_double) .approximates. real(my_val,kind=c_double) .within. tolerance) + diag = .all. (real(expected,kind=c_double) .approximates. real(my_val,kind=c_double) .within. tolerance) end function - function check_64_bit_real() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_64_bit_real() result(diag) + type(test_diagnosis_t) :: diag real(c_double), parameter :: values(*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2, 4]) real(c_double), parameter :: tolerance = 0_c_double @@ -162,11 +162,11 @@ function check_64_bit_real() result(test_diagnosis) call prif_co_min(my_val) expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (my_val .approximates. expected .within. tolerance) + diag = .all. (my_val .approximates. expected .within. tolerance) end function - function check_character() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_character() result(diag) + type(test_diagnosis_t) :: diag character(len=*), parameter :: values(*) = & [ "To be ","or not " & , "to ","be. " & @@ -183,7 +183,7 @@ function check_character() result(test_diagnosis) ! issue #205: workaround flang optimizer bug with a temp associate(tmp => [(values(mod(i-1,size(values))+1), i = 1, ni)]) - test_diagnosis = .all. (my_val .equalsExpected. minval(tmp)) + diag = .all. (my_val .equalsExpected. minval(tmp)) end associate end function diff --git a/test/prif_co_reduce_test.F90 b/test/prif_co_reduce_test.F90 index f63a097b..9715feb5 100644 --- a/test/prif_co_reduce_test.F90 +++ b/test/prif_co_reduce_test.F90 @@ -61,23 +61,26 @@ function results() result(test_results) ]) end function - function check_logical() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_logical() result(diag) + type(test_diagnosis_t) :: diag logical :: val integer :: me procedure(prif_operation_wrapper_interface), pointer :: op + diag = .true. op => and_wrapper val = .true. call prif_co_reduce(val, op, c_null_ptr) - test_diagnosis = .expect. val + diag = diag .also. & + .expect. val call prif_this_image_no_coarray(this_image=me) if (me == 1) then val = .false. end if call prif_co_reduce(val, op, c_null_ptr) - test_diagnosis = test_diagnosis .also. (.expect. (.not. val)) + diag = diag .also. & + .expect. (.not. val) end function subroutine and_wrapper(arg1, arg2_and_out, count, cdata) bind(C) @@ -96,8 +99,8 @@ subroutine and_wrapper(arg1, arg2_and_out, count, cdata) bind(C) end do end subroutine - function check_derived_type_reduction() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_derived_type_reduction() result(diag) + type(test_diagnosis_t) :: diag type(pair), parameter :: values(*,*) = reshape( & [ pair(1, 53.), pair(3, 47.) & , pair(5, 43.), pair(7, 41.) & @@ -134,7 +137,7 @@ function check_derived_type_reduction() result(test_diagnosis) #else expected = reduce(tmp, add_pair, dim=2) #endif - test_diagnosis = .all. (my_val%fst .equalsExpected. expected%fst) & + diag = .all. (my_val%fst .equalsExpected. expected%fst) & .also. (.all. ( real(my_val%snd, kind=kind(0.d0)) .approximates. real(expected%snd, kind=kind(0.d0)) .within. tolerance)) end function @@ -170,8 +173,8 @@ subroutine pair_adder(arg1, arg2_and_out, count, cdata) bind(C) ! Gfortran 14.2 also lacks the type support for this test: ! Error: Derived type 'pdtarray' at (1) is being used before it is defined - function check_type_parameter_reduction() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_type_parameter_reduction() result(diag) + type(test_diagnosis_t) :: diag type(array), parameter :: values(*,*) = reshape( & [ array(elements=[1, 53]), array(elements=[3, 47]) & , array(elements=[5, 43]), array(elements=[7, 41]) & @@ -194,7 +197,7 @@ function check_type_parameter_reduction() result(test_diagnosis) call prif_co_reduce(my_val, op, c_loc(context)) expected = reduce(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), add_array, dim=2) - test_diagnosis = .all. (my_val%elements .equalsExpected. expected%elements) + diag = .all. (my_val%elements .equalsExpected. expected%elements) end function pure function add_array(lhs, rhs) result(total) diff --git a/test/prif_co_sum_test.F90 b/test/prif_co_sum_test.F90 index e95de299..8a8d9aa8 100644 --- a/test/prif_co_sum_test.F90 +++ b/test/prif_co_sum_test.F90 @@ -47,8 +47,8 @@ function results() result(test_results) ]) end function - function check_default_integer() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_default_integer() result(diag) + type(test_diagnosis_t) :: diag integer, parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) integer :: me, ni, i @@ -61,11 +61,11 @@ function check_default_integer() result(test_diagnosis) call prif_co_sum(my_val) expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_8_bit_integer() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_8_bit_integer() result(diag) + type(test_diagnosis_t) :: diag integer(c_int8_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int8_t), [2, 4]) integer :: me, ni, i @@ -78,11 +78,11 @@ function check_8_bit_integer() result(test_diagnosis) call prif_co_sum(my_val) expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_16_bit_integer() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_16_bit_integer() result(diag) + type(test_diagnosis_t) :: diag integer(c_int16_t), parameter :: values(*,*) = reshape(int([1, -19, 5, 13, 11, 7, 17, 3],c_int16_t), [2, 4]) integer :: me, ni, i @@ -95,11 +95,11 @@ function check_16_bit_integer() result(test_diagnosis) call prif_co_sum(my_val) expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_32_bit_integer() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_32_bit_integer() result(diag) + type(test_diagnosis_t) :: diag integer(c_int32_t), parameter :: values(*) = [1, -19, 5, 13, 11, 7, 17, 3] integer :: me, ni, i @@ -112,11 +112,11 @@ function check_32_bit_integer() result(test_diagnosis) call prif_co_sum(my_val) expected = sum([(values(mod(i-1,size(values))+1), i = 1, ni)]) - test_diagnosis = int(my_val) .equalsExpected. int(expected) + diag = int(my_val) .equalsExpected. int(expected) end function - function check_64_bit_integer() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_64_bit_integer() result(diag) + type(test_diagnosis_t) :: diag integer(c_int64_t), parameter :: values(*,*) = reshape([1, -19, 5, 13, 11, 7, 17, 3], [2, 4]) integer :: me, ni, i @@ -129,11 +129,11 @@ function check_64_bit_integer() result(test_diagnosis) call prif_co_sum(my_val) expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (int(my_val) .equalsExpected. int(expected)) end function - function check_32_bit_real() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_32_bit_real() result(diag) + type(test_diagnosis_t) :: diag real(c_float), parameter :: values(*,*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2,2,2]) real(c_float), parameter :: tolerance = 0_c_float @@ -147,11 +147,11 @@ function check_32_bit_real() result(test_diagnosis) call prif_co_sum(my_val) expected = sum(reshape([(values(:,:,mod(i-1,size(values,3))+1), i = 1, ni)], [size(values,1), size(values,2), ni]), dim=3) - test_diagnosis = .all. (my_val .approximates. expected .within. tolerance) + diag = .all. (my_val .approximates. expected .within. tolerance) end function - function check_64_bit_real() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_64_bit_real() result(diag) + type(test_diagnosis_t) :: diag real(c_double), parameter :: values(*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2, 4]) real(c_double), parameter :: tolerance = 0_c_double @@ -165,11 +165,11 @@ function check_64_bit_real() result(test_diagnosis) call prif_co_sum(my_val) expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - test_diagnosis = .all. (my_val .approximates. expected .within. tolerance) + diag = .all. (my_val .approximates. expected .within. tolerance) end function - function check_32_bit_complex() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_32_bit_complex() result(diag) + type(test_diagnosis_t) :: diag complex(c_float), parameter :: values(*,*,*) = reshape( & [ cmplx(1., 53.), cmplx(3., 47.) & @@ -190,13 +190,13 @@ function check_32_bit_complex() result(test_diagnosis) expected = sum(reshape([(values(:,:,mod(i-1,size(values,3))+1), i = 1, ni)], [size(values,1), size(values,2), ni]), dim=3) - test_diagnosis = & + diag = & .all. (real(my_val) .approximates. real(expected) .within. tolerance) & .also. (.all. (aimag(my_val) .approximates. aimag(expected) .within. tolerance)) end function - function check_64_bit_complex() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_64_bit_complex() result(diag) + type(test_diagnosis_t) :: diag complex(c_double), parameter :: values(*,*) = reshape( & [ cmplx(1., 53.), cmplx(3., 47.) & @@ -217,7 +217,7 @@ function check_64_bit_complex() result(test_diagnosis) expected = sum(reshape([(values(:,mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1), ni]), dim=2) - test_diagnosis = & + diag = & .all. (real(my_val, c_double) .approximates. real(expected, c_double) .within. tolerance) & .also. (.all. (real(aimag(my_val), c_double) .approximates. real(aimag(expected), c_double) .within. tolerance)) end function diff --git a/test/prif_coarray_inquiry_test.F90 b/test/prif_coarray_inquiry_test.F90 index 5be8aac1..46496e46 100644 --- a/test/prif_coarray_inquiry_test.F90 +++ b/test/prif_coarray_inquiry_test.F90 @@ -47,8 +47,8 @@ function results() result(test_results) ]) end function - function check_prif_local_data_pointer() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_prif_local_data_pointer() result(diag) + type(test_diagnosis_t) :: diag integer(kind=c_int64_t), dimension(1) :: lcobounds, ucobounds integer :: dummy_element, num_imgs @@ -67,12 +67,12 @@ function check_prif_local_data_pointer() result(test_diagnosis) coarray_handle, & allocation_ptr) call prif_local_data_pointer(coarray_handle, local_ptr) - test_diagnosis = .expect. c_associated(local_ptr, allocation_ptr) + diag = .expect. c_associated(local_ptr, allocation_ptr) call prif_deallocate_coarray([coarray_handle]) end function - impure elemental function check_cobound(corank) result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + impure elemental function check_cobound(corank) result(diag) + type(test_diagnosis_t) :: diag integer(c_int), intent(in) :: corank ! Allocate memory for an integer scalar coarray with given corank @@ -86,6 +86,8 @@ impure elemental function check_cobound(corank) result(test_diagnosis) type(c_ptr) :: allocated_memory integer(c_size_t) :: data_size, query_size + diag = .true. + call prif_num_images(num_images=num_imgs) lcobounds(1) = 1 ucobounds(1) = num_imgs @@ -101,36 +103,43 @@ impure elemental function check_cobound(corank) result(test_diagnosis) lcobounds, ucobounds, data_size, c_null_funptr, & coarray_handle, allocated_memory) - test_diagnosis = .expect. c_associated(allocated_memory) + diag = diag .also. & + .expect. c_associated(allocated_memory) call prif_size_bytes(coarray_handle, data_size=query_size) - test_diagnosis = test_diagnosis .also. (query_size .equalsExpected. data_size) // "prif_size_bytes is valid" + diag = diag .also. & + (query_size .equalsExpected. data_size) // "prif_size_bytes is valid" call prif_lcobound_no_dim(coarray_handle, tmp_bounds) - test_diagnosis = test_diagnosis .also. (.all. (tmp_bounds .equalsExpected. lcobounds)) // "prif_lcobound_no_dim is valid" + diag = diag .also. & + (.all. (tmp_bounds .equalsExpected. lcobounds)) // "prif_lcobound_no_dim is valid" call prif_ucobound_no_dim(coarray_handle, tmp_bounds) - test_diagnosis = test_diagnosis .also. (.all. (tmp_bounds .equalsExpected. ucobounds)) // "prif_ucobound_no_dim is valid" + diag = diag .also. & + (.all. (tmp_bounds .equalsExpected. ucobounds)) // "prif_ucobound_no_dim is valid" do i = 1, corank call prif_lcobound_with_dim(coarray_handle, i, tmp_bound) - test_diagnosis = test_diagnosis .also. (tmp_bound .equalsExpected. lcobounds(i)) // "prif_lcobound_with_dim is valid" + diag = diag .also. & + (tmp_bound .equalsExpected. lcobounds(i)) // "prif_lcobound_with_dim is valid" call prif_ucobound_with_dim(coarray_handle, i, tmp_bound) - test_diagnosis = test_diagnosis .also. (tmp_bound .equalsExpected. ucobounds(i)) // "prif_ucobound_with_dim is valid" + diag = diag .also. & + (tmp_bound .equalsExpected. ucobounds(i)) // "prif_ucobound_with_dim is valid" end do call prif_coshape(coarray_handle, sizes) - test_diagnosis = test_diagnosis .also. (.all. ((ucobounds - lcobounds + 1) .equalsExpected. sizes)) // "prif_coshape is valid" + diag = diag .also. & + (.all. ((ucobounds - lcobounds + 1) .equalsExpected. sizes)) // "prif_coshape is valid" call prif_deallocate_coarray([coarray_handle]) end function - function check_cobounds() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_cobounds() result(diag) + type(test_diagnosis_t) :: diag integer(c_int) :: corank - test_diagnosis = .all. check_cobound([(corank, corank = 1_c_int, 15_c_int)]) + diag = .all. check_cobound([(corank, corank = 1_c_int, 15_c_int)]) end function end module prif_coarray_inquiry_test_m diff --git a/test/prif_image_queries_test.F90 b/test/prif_image_queries_test.F90 index 3ab99499..68fd2141 100644 --- a/test/prif_image_queries_test.F90 +++ b/test/prif_image_queries_test.F90 @@ -44,22 +44,22 @@ function results() result(test_results) ]) end function - function check_image_status() result(test_diagnosis) - type(test_diagnosis_t) :: test_diagnosis + function check_image_status() result(diag) + type(test_diagnosis_t) :: diag integer(c_int) :: image_status call prif_image_status(1, image_status=image_status) - test_diagnosis = .expect. (any(image_status == [0, PRIF_STAT_FAILED_IMAGE, PRIF_STAT_STOPPED_IMAGE])) & ! TODO: replace with .any. once Juliennes supports it + diag = .expect. (any(image_status == [0, PRIF_STAT_FAILED_IMAGE, PRIF_STAT_STOPPED_IMAGE])) & ! TODO: replace with .any. once Juliennes supports it // "permitted image status" end function - function valid_image_list(nums) result(test_diagnosis) + function valid_image_list(nums) result(diag) integer, allocatable, intent(in) :: nums(:) - type(test_diagnosis_t) test_diagnosis + type(test_diagnosis_t) :: diag integer ni call prif_num_images(num_images=ni) - test_diagnosis = & + diag = & .expect. allocated(nums) & .also. (size(nums) .isAtMost. ni) & .also. (.all. (nums .isAtLeast. 1)) & @@ -67,20 +67,20 @@ function valid_image_list(nums) result(test_diagnosis) .also. (.all. (nums(1:size(nums)-1) .lessThan. nums(2:size(nums)))) // "valid stopped image" end function - function check_stopped_images() result(test_diagnosis) - type(test_diagnosis_t) :: test_diagnosis + function check_stopped_images() result(diag) + type(test_diagnosis_t) :: diag integer, allocatable :: nums(:) call prif_stopped_images(stopped_images=nums) - test_diagnosis = valid_image_list(nums) + diag = valid_image_list(nums) end function - function check_failed_images() result(test_diagnosis) - type(test_diagnosis_t) :: test_diagnosis + function check_failed_images() result(diag) + type(test_diagnosis_t) :: diag integer, allocatable :: nums(:) call prif_failed_images(failed_images=nums) - test_diagnosis = valid_image_list(nums) + diag = valid_image_list(nums) end function end module prif_image_queries_test_m diff --git a/test/prif_init_test.F90 b/test/prif_init_test.F90 index 49ad33d3..fd57b0cb 100644 --- a/test/prif_init_test.F90 +++ b/test/prif_init_test.F90 @@ -30,9 +30,9 @@ function results() result(test_results) end function - function check_caffeination() result(test_diagnosis) + function check_caffeination() result(diag) ! this test needs to run very early at startup, so we memoize the result - type(test_diagnosis_t) :: test_diagnosis + type(test_diagnosis_t) :: diag type(test_diagnosis_t), save :: memo logical, save :: first_pass = .true. @@ -52,16 +52,16 @@ function check_caffeination() result(test_diagnosis) end block write_memo endif - test_diagnosis = memo + diag = memo end function - function check_subsequent_prif_init_call() result(test_diagnosis) - type(test_diagnosis_t) :: test_diagnosis + function check_subsequent_prif_init_call() result(diag) + type(test_diagnosis_t) :: diag integer stat call prif_init(stat) call prif_init(stat) - test_diagnosis = stat .equalsExpected. PRIF_STAT_ALREADY_INIT + diag = stat .equalsExpected. PRIF_STAT_ALREADY_INIT end function end module prif_init_test_m diff --git a/test/prif_num_images_test.F90 b/test/prif_num_images_test.F90 index 7baec653..c817446b 100644 --- a/test/prif_num_images_test.F90 +++ b/test/prif_num_images_test.F90 @@ -36,11 +36,11 @@ function results() result(test_results) end function - function check_num_images_valid() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_num_images_valid() result(diag) + type(test_diagnosis_t) :: diag integer num_imgs call prif_num_images(num_images=num_imgs) - test_diagnosis = (num_imgs .isAtLeast. 1) // "positive number of images" + diag = (num_imgs .isAtLeast. 1) // "positive number of images" end function end module prif_num_images_test_m diff --git a/test/prif_sync_images_test.F90 b/test/prif_sync_images_test.F90 index 66ec85ad..710f4115 100644 --- a/test/prif_sync_images_test.F90 +++ b/test/prif_sync_images_test.F90 @@ -33,8 +33,8 @@ function results() result(test_results) ]) end function - function check_serial() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_serial() result(diag) + type(test_diagnosis_t) :: diag integer(c_int) :: me integer i @@ -47,12 +47,12 @@ function check_serial() result(test_diagnosis) end do call prif_sync_all - test_diagnosis = .expect. .true. + diag = .true. end function - function check_neighbor() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_neighbor() result(diag) + type(test_diagnosis_t) :: diag integer(c_int) me, num_imgs integer i @@ -67,11 +67,11 @@ function check_neighbor() result(test_diagnosis) end do call prif_sync_all - test_diagnosis = .expect. .true. + diag = .true. end function - function check_hot() result(test_diagnosis) - type(test_diagnosis_t) test_diagnosis + function check_hot() result(diag) + type(test_diagnosis_t) :: diag integer(c_int) :: me, num_imgs integer :: i @@ -99,7 +99,7 @@ function check_hot() result(test_diagnosis) endif call prif_sync_all - test_diagnosis = .expect. .true. + diag = .true. end function end module prif_sync_images_test_m diff --git a/test/prif_this_image_test.F90 b/test/prif_this_image_test.F90 index 6494d9bf..5aa071d1 100644 --- a/test/prif_this_image_test.F90 +++ b/test/prif_this_image_test.F90 @@ -35,8 +35,8 @@ function results() result(test_results) ]) end function - function check_this_image_set() result(test_diagnosis) - type(test_diagnosis_t) :: test_diagnosis + function check_this_image_set() result(diag) + type(test_diagnosis_t) :: diag integer, allocatable :: image_numbers(:) integer i, me, ni @@ -44,7 +44,7 @@ function check_this_image_set() result(test_diagnosis) call prif_num_images(num_images=ni) image_numbers = [(merge(0, me, me/=i), i = 1, ni)] call prif_co_sum(image_numbers) - test_diagnosis = .all. (image_numbers .equalsExpected. [(i, i = 1, ni)]) // "correct image set" + diag = .all. (image_numbers .equalsExpected. [(i, i = 1, ni)]) // "correct image set" end function end module prif_this_image_no_coarray_test_m From 847b3931a1802655a4961a7a40e7df765229cc21 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 14 Nov 2025 22:05:15 -0800 Subject: [PATCH 09/13] Use Julienne .expectEquals. support for 64-bit integers Prefer 64-bit comparison for any use case where a truncating conversion could plausibly mask a defect. Also, use native kind real comparison whenever possible. --- test/prif_co_max_test.F90 | 2 +- test/prif_co_min_test.F90 | 6 +++--- test/prif_co_reduce_test.F90 | 4 ++-- test/prif_co_sum_test.F90 | 2 +- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/test/prif_co_max_test.F90 b/test/prif_co_max_test.F90 index 2abc8a6a..0b6484c6 100644 --- a/test/prif_co_max_test.F90 +++ b/test/prif_co_max_test.F90 @@ -128,7 +128,7 @@ function check_64_bit_integer() result(diag) call prif_co_max(my_val) expected = maxval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - diag = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (my_val .equalsExpected. expected) end function function check_32_bit_real() result(diag) diff --git a/test/prif_co_min_test.F90 b/test/prif_co_min_test.F90 index 625c989a..f2ce72f3 100644 --- a/test/prif_co_min_test.F90 +++ b/test/prif_co_min_test.F90 @@ -126,14 +126,14 @@ function check_64_bit_integer() result(diag) call prif_co_min(my_val) expected = minval(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - diag = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (my_val .equalsExpected. expected) end function function check_32_bit_real() result(diag) type(test_diagnosis_t) :: diag real(c_float), parameter :: values(*,*,*) = reshape([1, 19, 5, 13, 11, 7, 17, 3], [2,2,2]) - real(c_double), parameter :: tolerance = 0_c_double + real(c_float), parameter :: tolerance = 0_c_double integer :: me, ni, i real(c_float), dimension(size(values,1), size(values,2)) :: my_val, expected @@ -144,7 +144,7 @@ function check_32_bit_real() result(diag) call prif_co_min(my_val) expected = minval(reshape([(values(:,:,mod(i-1,size(values,3))+1), i = 1, ni)], [size(values,1), size(values,2), ni]), dim=3) - diag = .all. (real(expected,kind=c_double) .approximates. real(my_val,kind=c_double) .within. tolerance) + diag = .all. (expected .approximates. my_val .within. tolerance) end function function check_64_bit_real() result(diag) diff --git a/test/prif_co_reduce_test.F90 b/test/prif_co_reduce_test.F90 index 9715feb5..26f3483a 100644 --- a/test/prif_co_reduce_test.F90 +++ b/test/prif_co_reduce_test.F90 @@ -112,7 +112,7 @@ function check_derived_type_reduction() result(diag) type(pair), dimension(size(values,1)) :: my_val, expected type(pair), dimension(:,:), allocatable :: tmp procedure(prif_operation_wrapper_interface), pointer :: op - double precision, parameter :: tolerance = 0D0 + real, parameter :: tolerance = 0D0 op => pair_adder call prif_this_image_no_coarray(this_image=me) @@ -138,7 +138,7 @@ function check_derived_type_reduction() result(diag) expected = reduce(tmp, add_pair, dim=2) #endif diag = .all. (my_val%fst .equalsExpected. expected%fst) & - .also. (.all. ( real(my_val%snd, kind=kind(0.d0)) .approximates. real(expected%snd, kind=kind(0.d0)) .within. tolerance)) + .also. (.all. ( my_val%snd .approximates. expected%snd .within. tolerance)) end function pure function add_pair(lhs, rhs) result(total) diff --git a/test/prif_co_sum_test.F90 b/test/prif_co_sum_test.F90 index 8a8d9aa8..9f09f621 100644 --- a/test/prif_co_sum_test.F90 +++ b/test/prif_co_sum_test.F90 @@ -129,7 +129,7 @@ function check_64_bit_integer() result(diag) call prif_co_sum(my_val) expected = sum(reshape([(values(:, mod(i-1,size(values,2))+1), i = 1, ni)], [size(values,1),ni]), dim=2) - diag = .all. (int(my_val) .equalsExpected. int(expected)) + diag = .all. (my_val .equalsExpected. expected) end function function check_32_bit_real() result(diag) From c7b3d450d0111812a6940492a0984347622f6eb8 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Fri, 14 Nov 2025 22:53:43 -0800 Subject: [PATCH 10/13] Fix a harmless warning --- test/prif_co_max_test.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/prif_co_max_test.F90 b/test/prif_co_max_test.F90 index 0b6484c6..71edda13 100644 --- a/test/prif_co_max_test.F90 +++ b/test/prif_co_max_test.F90 @@ -175,7 +175,7 @@ function check_character() result(diag) , "that ","is " & , "the ","question"] integer :: me, ni, i - character(len=len(values)) :: my_val, expected + character(len=len(values)) :: my_val call prif_this_image_no_coarray(this_image=me) call prif_num_images(ni) From da7f7cd32228f2fa78ed5cea2f1b1e5b5f6d173f Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Sat, 15 Nov 2025 12:11:57 -0800 Subject: [PATCH 11/13] julienne-driver: Reorder test fixtures Reorder unit-testing to roughly start from the simplest and most fundamental features, as these are assumed to work correctly by later tests of more complicated features. --- test/julienne-driver.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/test/julienne-driver.F90 b/test/julienne-driver.F90 index 77155194..677609a5 100644 --- a/test/julienne-driver.F90 +++ b/test/julienne-driver.F90 @@ -18,16 +18,16 @@ program test_suite_driver 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_num_images_test_t() ) & + ,test_fixture_t( prif_this_image_no_coarray_test_t() ) & + ,test_fixture_t( prif_image_queries_test_t() ) & ,test_fixture_t( prif_co_broadcast_test_t() ) & + ,test_fixture_t( prif_co_sum_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_coarray_inquiry_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 From 9415c429c2fd50e82d82f86503dd65a6a2b687c4 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 18 Nov 2025 18:16:49 -0600 Subject: [PATCH 12/13] chore(image_queries_test): adopt alignment pattern Co-authored-by: Dan Bonachea --- test/prif_image_queries_test.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/test/prif_image_queries_test.F90 b/test/prif_image_queries_test.F90 index 68fd2141..23348a7a 100644 --- a/test/prif_image_queries_test.F90 +++ b/test/prif_image_queries_test.F90 @@ -60,11 +60,11 @@ function valid_image_list(nums) result(diag) call prif_num_images(num_images=ni) diag = & - .expect. allocated(nums) & - .also. (size(nums) .isAtMost. ni) & - .also. (.all. (nums .isAtLeast. 1)) & - .also. (.all. (nums .isAtMost. ni)) & - .also. (.all. (nums(1:size(nums)-1) .lessThan. nums(2:size(nums)))) // "valid stopped image" + .expect. allocated(nums) .also. & + (size(nums) .isAtMost. ni) .also. & + (.all. (nums .isAtLeast. 1)) .also. & + (.all. (nums .isAtMost. ni)) .also. & + (.all. (nums(1:size(nums)-1) .lessThan. nums(2:size(nums)))) // "valid stopped image" end function function check_stopped_images() result(diag) From b2977a62c76f5d7622f41e6bd296e77adcd8172e Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Tue, 18 Nov 2025 19:39:36 -0800 Subject: [PATCH 13/13] test/prif_init_test: Remove superfluous memoization on check_caffeination Julienne guarantees that `test_fixture_t` elements in a `test_harness_t` are executed strictly in-order, so we don't need a hack to ensure proper initialization ordering. --- test/julienne-driver.F90 | 2 +- test/prif_init_test.F90 | 22 +++++----------------- 2 files changed, 6 insertions(+), 18 deletions(-) diff --git a/test/julienne-driver.F90 b/test/julienne-driver.F90 index 677609a5..664a2406 100644 --- a/test/julienne-driver.F90 +++ b/test/julienne-driver.F90 @@ -17,7 +17,7 @@ program test_suite_driver implicit none associate(test_harness => test_harness_t([ & - test_fixture_t( prif_init_test_t() ) & + test_fixture_t( prif_init_test_t() ) & ! must come first ,test_fixture_t( prif_num_images_test_t() ) & ,test_fixture_t( prif_this_image_no_coarray_test_t() ) & ,test_fixture_t( prif_image_queries_test_t() ) & diff --git a/test/prif_init_test.F90 b/test/prif_init_test.F90 index fd57b0cb..dcb0931d 100644 --- a/test/prif_init_test.F90 +++ b/test/prif_init_test.F90 @@ -31,28 +31,16 @@ function results() result(test_results) function check_caffeination() result(diag) - ! this test needs to run very early at startup, so we memoize the result type(test_diagnosis_t) :: diag - type(test_diagnosis_t), save :: memo - logical, save :: first_pass = .true. - - if (first_pass) then - first_pass = .false. - write_memo: & - block #if HAVE_MULTI_IMAGE - integer, parameter :: successful_initiation = PRIF_STAT_ALREADY_INIT + integer, parameter :: successful_initiation = PRIF_STAT_ALREADY_INIT #else - integer, parameter :: successful_initiation = 0 + integer, parameter :: successful_initiation = 0 #endif - integer init_exit_code - - call prif_init(init_exit_code) - memo = init_exit_code .equalsExpected. successful_initiation - end block write_memo - endif + integer init_exit_code - diag = memo + call prif_init(init_exit_code) + diag = init_exit_code .equalsExpected. successful_initiation end function function check_subsequent_prif_init_call() result(diag)