diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 844b980fd..07776ee81 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 diff --git a/include/language-support.F90 b/include/language-support.F90 index 5130650ba..e75b74cb0 100644 --- a/include/language-support.F90 +++ b/include/language-support.F90 @@ -1,6 +1,10 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt +#ifdef __GNUC__ +# define HAVE_GCC_VERSION (__GNUC__ * 10000 + __GNUC_MINOR__ * 100 + __GNUC_PATCHLEVEL__) +#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 +19,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__) || (HAVE_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/manifest/fpm.toml.template b/manifest/fpm.toml.template index 394c37266..dca00f2e4 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 diff --git a/test/julienne-driver.F90 b/test/julienne-driver.F90 new file mode 100644 index 000000000..664a24067 --- /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() ) & ! 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() ) & + ,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_coarray_inquiry_test_t() ) & + ,test_fixture_t( prif_sync_images_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 dbbaf8f21..425fb2ea6 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 d7e6f7935..3ba12c5cb 100644 --- a/test/prif_co_broadcast_test.F90 +++ b/test/prif_co_broadcast_test.F90 @@ -1,10 +1,24 @@ -module caf_co_broadcast_test +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 : & + usher & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t & + ,operator(//) & + ,operator(.expect.) & + ,operator(.equalsExpected.) 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,13 +33,18 @@ 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 = "prif_co_broadcast" + end function + + 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", usher(broadcast_default_integer_scalar)) & + ,test_description_t("broadcasting a derived type scalar with no allocatable components", usher(broadcast_derived_type)) & ]) end function @@ -39,30 +58,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(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) - result_ = assert_equals(source_value, iPhone) + diag = iPhone .equalsExpected. source_value end function - function broadcast_derived_type() result(result_) - type(result_t) result_ + function broadcast_derived_type() result(diag) + type(test_diagnosis_t) :: diag 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") + diag = .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 5305b037d..71edda131 100644 --- a/test/prif_co_max_test.F90 +++ b/test/prif_co_max_test.F90 @@ -1,31 +1,53 @@ -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 - +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.) & + ,usher & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t 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 = "prif_co_max" + end function + + 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", 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 - function check_default_integer() result(result_) - type(result_t) :: result_ + 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 @@ -38,11 +60,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)) + diag = .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(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 @@ -55,11 +77,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)) + diag = .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(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 @@ -72,11 +94,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)) + diag = .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(diag) + type(test_diagnosis_t) :: diag integer(c_int32_t), parameter :: values(*) = [1, -19, 5, 13, 11, 7, 17, 3] integer :: me, ni, i @@ -89,11 +111,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) + diag = my_val .equalsExpected. expected end function - function check_64_bit_integer() result(result_) - type(result_t) :: result_ + 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 @@ -106,13 +128,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)) + diag = .all. (my_val .equalsExpected. expected) end function - function check_32_bit_real() result(result_) - type(result_t) :: result_ + 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 integer :: me, ni, i real(c_float), dimension(size(values,1), size(values,2)) :: my_val, expected @@ -123,13 +146,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)) + diag = .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(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 integer :: me, ni, i real(c_double), dimension(size(values,1)) :: my_val, expected @@ -140,18 +164,18 @@ 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) + diag = .all. (my_val .approximates. expected .within. tolerance) end function - function check_character() result(result_) - type(result_t) result_ + function check_character() result(diag) + type(test_diagnosis_t) :: diag 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 + character(len=len(values)) :: my_val call prif_this_image_no_coarray(this_image=me) call prif_num_images(ni) @@ -161,9 +185,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) + diag = 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 2a85a2bc2..f2ce72f3f 100644 --- a/test/prif_co_min_test.F90 +++ b/test/prif_co_min_test.F90 @@ -1,169 +1,190 @@ -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 +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.) & + ,usher & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t + 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 + pure function subject() result(test_subject) + character(len=:), allocatable :: test_subject + test_subject = "prif_co_min" + end function + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_co_min_test_t) prif_co_min_test - 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 + test_results = prif_co_min_test%run([ & + 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 - function check_default_integer() result(result_) - type(result_t) :: result_ + 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 - integer, dimension(size(values,1)) :: my_val, expected + 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 - 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) + diag = .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(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 - integer(c_int8_t), dimension(size(values,1)) :: my_val, expected + 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) + 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) + diag = .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(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 - integer(c_int16_t), dimension(size(values,1)) :: my_val, expected + 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) + 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) + diag = .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(diag) + type(test_diagnosis_t) :: diag - 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 + 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))+1) - call prif_co_min(my_val) + 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)]) - result_ = assert_equals(expected, my_val) - end function + expected = minval([(values(mod(i-1,size(values))+1), i = 1, ni)]) + diag = 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(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 - 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) + diag = .all. (my_val .equalsExpected. expected) + end function - function check_32_bit_real() result(result_) - type(result_t) :: result_ + 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]) - 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_float), 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) + diag = .all. (expected .approximates. my_val .within. tolerance) + end function - function check_64_bit_real() result(result_) - type(result_t) :: result_ + 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]) - 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) + diag = .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(diag) + type(test_diagnosis_t) :: diag + 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)]) + diag = .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 ebcbcf22f..26f3483a4 100644 --- a/test/prif_co_reduce_test.F90 +++ b/test/prif_co_reduce_test.F90 @@ -1,11 +1,28 @@ -module caf_co_reduce_test +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.) & + ,usher & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t 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,36 +43,44 @@ 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 = "prif_co_reduce" + end function + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_co_reduce_test_t) prif_co_reduce_test - 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", usher(check_logical)) & + ,test_description_t("performing a derived type reduction", usher(check_derived_type_reduction)) & #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", usher(check_type_parameter_reduction)) & #endif ]) end function - function check_logical() result(result_) - type(result_t) :: result_ + 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) - result_ = assert_that(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) - result_ = result_.and.assert_not(val) + diag = diag .also. & + .expect. (.not. val) end function subroutine and_wrapper(arg1, arg2_and_out, count, cdata) bind(C) @@ -74,8 +99,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(diag) + type(test_diagnosis_t) :: diag type(pair), parameter :: values(*,*) = reshape( & [ pair(1, 53.), pair(3, 47.) & , pair(5, 43.), pair(7, 41.) & @@ -87,6 +112,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 + real, parameter :: tolerance = 0D0 op => pair_adder call prif_this_image_no_coarray(this_image=me) @@ -111,9 +137,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))) + diag = .all. (my_val%fst .equalsExpected. expected%fst) & + .also. (.all. ( my_val%snd .approximates. expected%snd .within. tolerance)) end function pure function add_pair(lhs, rhs) result(total) @@ -148,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(result_) - type(result_t) :: result_ + 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]) & @@ -172,9 +197,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 + diag = .all. (my_val%elements .equalsExpected. expected%elements) end function pure function add_array(lhs, rhs) result(total) @@ -216,4 +239,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 665b36e41..9f09f6218 100644 --- a/test/prif_co_sum_test.F90 +++ b/test/prif_co_sum_test.F90 @@ -1,197 +1,225 @@ -module caf_co_sum_test +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.) & + ,usher & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t implicit none private - public :: test_prif_co_sum + public :: prif_co_sum_test_t + + type, extends(test_t) :: prif_co_sum_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type 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 + pure function subject() result(test_subject) + character(len=:), allocatable :: test_subject + test_subject = "prif_co_sum" + end function + + 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", 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 + + 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 + integer, dimension(size(values,1)) :: my_val, expected - function check_default_integer() result(result_) - type(result_t) :: result_ + 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 :: me, ni, i - integer, 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) + diag = .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_8_bit_integer() result(diag) + type(test_diagnosis_t) :: diag - 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 + 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 - function check_8_bit_integer() result(result_) - type(result_t) :: result_ + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) - 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 + 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) + diag = .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_16_bit_integer() result(diag) + type(test_diagnosis_t) :: diag - 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 + 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 - function check_16_bit_integer() result(result_) - type(result_t) :: result_ + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) - 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 + 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) + diag = .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_integer() result(diag) + type(test_diagnosis_t) :: diag - 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 + 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 - function check_32_bit_integer() result(result_) - type(result_t) :: result_ + call prif_this_image_no_coarray(this_image=me) + call prif_num_images(ni) - 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 + my_val = values(mod(me-1, size(values))+1) + call prif_co_sum(my_val) - call prif_this_image_no_coarray(this_image=me) - call prif_num_images(ni) + expected = sum([(values(mod(i-1,size(values))+1), i = 1, ni)]) + diag = 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(diag) + type(test_diagnosis_t) :: diag - 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) + diag = .all. (my_val .equalsExpected. 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(diag) + type(test_diagnosis_t) :: diag - 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) + diag = .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(diag) + type(test_diagnosis_t) :: diag - 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) + diag = .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(diag) + type(test_diagnosis_t) :: diag - 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) + diag = & + .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(diag) + type(test_diagnosis_t) :: diag - 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 + 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 -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 f2e1298dd..46496e46c 100644 --- a/test/prif_coarray_inquiry_test.F90 +++ b/test/prif_coarray_inquiry_test.F90 @@ -1,135 +1,145 @@ -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 +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.) & + ,usher & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t + 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 = "PRIF coarray inquiry procedures" + end function + + 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", usher(check_prif_local_data_pointer)) & + ,test_description_t("checking passed cobounds", usher(check_cobounds)) & + ]) + end function + + 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 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) + diag = .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(diag) + type(test_diagnosis_t) :: diag + 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 + + diag = .true. + + 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) + + diag = diag .also. & + .expect. c_associated(allocated_memory) + + call prif_size_bytes(coarray_handle, data_size=query_size) + diag = diag .also. & + (query_size .equalsExpected. data_size) // "prif_size_bytes is valid" + + call prif_lcobound_no_dim(coarray_handle, tmp_bounds) + diag = diag .also. & + (.all. (tmp_bounds .equalsExpected. lcobounds)) // "prif_lcobound_no_dim is valid" + + call prif_ucobound_no_dim(coarray_handle, tmp_bounds) + 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) + diag = diag .also. & + (tmp_bound .equalsExpected. lcobounds(i)) // "prif_lcobound_with_dim is valid" + + call prif_ucobound_with_dim(coarray_handle, i, tmp_bound) + diag = diag .also. & + (tmp_bound .equalsExpected. ucobounds(i)) // "prif_ucobound_with_dim is valid" + end do + + call prif_coshape(coarray_handle, sizes) + 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(diag) + type(test_diagnosis_t) :: diag + integer(c_int) :: corank + + 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 d416131ad..23348a7a6 100644 --- a/test/prif_image_queries_test.F90 +++ b/test/prif_image_queries_test.F90 @@ -1,61 +1,86 @@ -module caf_image_queries_test +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.) & + ,usher & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t 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 query procedures" + end function + + 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()", 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 + + 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) + 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(diag) + integer, allocatable, intent(in) :: nums(:) + type(test_diagnosis_t) :: diag + integer ni + + 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" + end function + + function check_stopped_images() result(diag) + type(test_diagnosis_t) :: diag + integer, allocatable :: nums(:) + + call prif_stopped_images(stopped_images=nums) + diag = valid_image_list(nums) + end function + + function check_failed_images() result(diag) + type(test_diagnosis_t) :: diag + integer, allocatable :: nums(:) + + call prif_failed_images(failed_images=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 new file mode 100644 index 000000000..dcb0931dc --- /dev/null +++ b/test/prif_init_test.F90 @@ -0,0 +1,55 @@ +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 + + 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 = "prif_init" + end function + + 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", usher(check_caffeination)) & + ,test_description_t("returning PRIF_STAT_ALREADY_INIT on a subsequent call ", usher(check_subsequent_prif_init_call)) & + ]) + end function + + + function check_caffeination() result(diag) + type(test_diagnosis_t) :: diag +#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) + diag = init_exit_code .equalsExpected. successful_initiation + end function + + function check_subsequent_prif_init_call() result(diag) + type(test_diagnosis_t) :: diag + integer stat + + call prif_init(stat) + call prif_init(stat) + 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 4640a15a7..c817446bd 100644 --- a/test/prif_num_images_test.F90 +++ b/test/prif_num_images_test.F90 @@ -1,27 +1,46 @@ -module caf_num_images_test +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.) & + ,usher & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t 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 = "prif_num_images" + end function + + 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", usher(check_num_images_valid)) & ]) end function - function check_num_images_valid() result(result_) - type(result_t) :: result_ - integer :: num_imgs + + function check_num_images_valid() result(diag) + type(test_diagnosis_t) :: diag + integer num_imgs call prif_num_images(num_images=num_imgs) - result_ = assert_that(num_imgs>0, "positive number of images") + diag = (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 d719c8dd7..710f41153 100644 --- a/test/prif_sync_images_test.F90 +++ b/test/prif_sync_images_test.F90 @@ -1,30 +1,42 @@ -module caf_sync_images_test +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.), usher 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 = "prif_sync_images" + end function + + 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", 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 - function check_serial() result(result_) - type(result_t) :: result_ + function check_serial() result(diag) + type(test_diagnosis_t) :: diag integer(c_int) :: me - integer :: i + integer i call prif_this_image_no_coarray(this_image=me) call prif_sync_all @@ -35,14 +47,14 @@ function check_serial() result(result_) end do call prif_sync_all - result_ = succeed("") + diag = .true. end function - function check_neighbor() result(result_) - type(result_t) :: result_ - integer(c_int) :: me, num_imgs - integer :: i + function check_neighbor() result(diag) + type(test_diagnosis_t) :: diag + 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 +67,11 @@ function check_neighbor() result(result_) end do call prif_sync_all - result_ = succeed("") + diag = .true. end function - function check_hot() result(result_) - type(result_t) :: result_ + function check_hot() result(diag) + type(test_diagnosis_t) :: diag integer(c_int) :: me, num_imgs integer :: i @@ -87,8 +99,7 @@ function check_hot() result(result_) endif call prif_sync_all - result_ = succeed("") + diag = .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 e6bf04ca4..5aa071d1e 100644 --- a/test/prif_this_image_test.F90 +++ b/test/prif_this_image_test.F90 @@ -1,33 +1,50 @@ -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 +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.) & + ,usher & + ,test_description_t & + ,test_diagnosis_t & + ,test_result_t & + ,test_t + implicit none - implicit none - private - public :: test_prif_this_image_no_coarray + 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 = "prif_this_image_no_coarray" + end function + + 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", usher(check_this_image_set)) & + ]) + end function + + function check_this_image_set() result(diag) + type(test_diagnosis_t) :: diag + 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) + diag = .all. (image_numbers .equalsExpected. [(i, i = 1, ni)]) // "correct image set" + end function + +end module prif_this_image_no_coarray_test_m