diff --git a/docs/README-maintainers.md b/docs/README-maintainers.md index 44945d6e..cb2cc4ec 100644 --- a/docs/README-maintainers.md +++ b/docs/README-maintainers.md @@ -4,18 +4,28 @@ README-maintainers.md Conventions for Git and Pull Requests ------------- -This repository aims to maintain a mostly linear history. In order to achieve this, please + +This repository follows the [fork-and-pull](https://docs.github.com/en/pull-requests/collaborating-with-pull-requests/getting-started/about-collaborative-development-models#fork-and-pull-model) model of development. +If you would like to contribute some changes, please +[fork](https://docs.github.com/en/pull-requests/collaborating-with-pull-requests/working-with-forks) this repository, +push your proposed edits to a feature branch in your fork, and then +[open a pull request](https://docs.github.com/en/pull-requests/collaborating-with-pull-requests/proposing-changes-to-your-work-with-pull-requests) against this repo when the changes are ready for review. + + +This repository aims to maintain a strictly linear git history. In order to achieve this, please observe the following workflow: -* Checkout a feature branch and open a PR when the changes are ready for review -* After your PR has been approved, make sure to rebase your feature branch with `origin/main`. + +* After your PR has been approved, your feature branch will be rebased onto `origin/main` before merge. * In general you should try to avoid rebasing a non-draft PR with pending approvals until the last step before merge, because it complicates iterative review. -* Only after your feature branch is up-to-date with `origin/main`, then you may merge the branch +* Only after your feature branch is up-to-date with `origin/main` may it then be merged into `main` with a merge commit. -Additional git policies: -* Never force push to `main` +Additional git policies for the primary Caffeine repository: +* Never force push to `main` +* All code changes and non-trivial documentation changes require a pull request +* No stray branches, except for rare cases of long-lived parallel development Conventions for code and commits in Caffeine ------------- @@ -29,7 +39,7 @@ Conventions for code and commits in Caffeine * C functions and global variables lacking a `caf_` prefix must be `static` * Identifiers named `image` and `rank` refer to processes. Any identifier named `image` represents the process as 1-based number (Fortran-style), while `rank` represents the process as 0-based - number (C-style) (i.e. rank = image -1) + number (C-style) (i.e. rank == image - 1) * When writing or making changes to BIND(C) interfaces, be vigilant when checking that the types and attributes of the arguments and return values are equivalent across the Fortran and C declarations @@ -41,4 +51,18 @@ Conventions for code and commits in Caffeine * Similarly if you need to move blocks of lines unchanged between distant locations or rename files, please also isolate those changes in a separate commit with a commit message explaining the lack of meaningful change. -* Tab characters should NOT be used in source code +* Tab characters should NEVER appear in source code + +Conventions for test code +------------------------- +* All significant features should have non-trivial correctness tests in `test/` +* Every PRIF procedure must be invoked by at least one test +* Correctness tests should aim to achieve complete code coverage of internal paths, + and exercise any important corner-cases. +* Test functions should return a Julienne `test_diagnosis_t` named `diag` + - If a complete diagnosis can be computed using a single Fortran expression `expr`, + then the statement `diag = expr` should appear near the end of the procedure. + - Otherwise, the statement `diag = .true.` must appear as the first executable + statement in the procedure, and the `ALSO/ALSO2` macros defined by + [test-utils.F90](../test/test-utils.F90) should be invoked to build an incremental diagnosis. + diff --git a/install.sh b/install.sh index c570ae57..e71ac036 100755 --- a/install.sh +++ b/install.sh @@ -487,6 +487,8 @@ cat << EOF > $RUN_FPM_SH #!/bin/sh #-- DO NOT EDIT -- created by caffeine/install.sh fpm="${FPM}" +FPM_DRIVER=\${FPM_DRIVER:-\`realpath \$0\`} +export FPM_DRIVER fpm_sub_cmd=\$1; shift if echo "--help -help --version -version --list -list new update list clean publish" | grep -w -q -e "\$fpm_sub_cmd" ; then set -x diff --git a/manifest/fpm.toml.template b/manifest/fpm.toml.template index dca00f2e..695afe66 100644 --- a/manifest/fpm.toml.template +++ b/manifest/fpm.toml.template @@ -7,9 +7,7 @@ copyright = "2021-2025 The Regents of the University of California, through Lawr [dev-dependencies] 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"} +julienne = {git = "https://github.com/berkeleylab/julienne.git", tag = "3.5.0"} [install] library = true diff --git a/src/caffeine/unit_test_parameters_m.F90 b/src/caffeine/unit_test_parameters_m.F90 index 7a9169de..3815a0ca 100644 --- a/src/caffeine/unit_test_parameters_m.F90 +++ b/src/caffeine/unit_test_parameters_m.F90 @@ -12,32 +12,57 @@ module unit_test_parameters_m ! used in stop/error-stop unit tests and example/test-support supporting programs character(len=:), allocatable :: subjob_prefix + character(len=:), allocatable :: fpm_driver contains + ! Retrieve an environment parameter or its default value + subroutine getenv_withdefault(key, default, result) + use iso_fortran_env, only: error_unit + character(len=*), intent(in) :: key, default + character(len=:), allocatable, intent(inout) :: result + character(len=:), allocatable :: suffix + + character :: dummy + integer :: len + + ! TODO: it would be preferable to consult the GASNet global environment, when available + call get_environment_variable(key, dummy, len) + if (len > 0) then + allocate(character(len=len)::result) + call get_environment_variable(key, result, len) + result = trim(adjustl(result)) + suffix = "" + else + result = default + suffix = " (default)" + endif + + ! report the envvar in verbose mode + call get_environment_variable("GASNET_VERBOSEENV", dummy, len) + if (len > 0) then + write(error_unit, '(A, T64, A)') "ENV parameter: "//key//"='"//result//"'", suffix + end if + end subroutine + ! subjob support used by stop/error-stop unit tests ! setup for subjob launch, initializes subjob_prefix and ! returns whether this is the first image function subjob_setup() result(result_) - character(len=*), parameter :: envvar = "SUBJOB_PREFIX" logical :: result_ - integer :: me, len - character :: dummy + integer :: me if (.not. allocated(subjob_prefix)) then - call get_environment_variable(envvar, dummy, len) - if (len > 0) then - allocate(character(len=len+1)::subjob_prefix) - call get_environment_variable(envvar, subjob_prefix, len) - else - subjob_prefix = "" - endif - !print *,"SUBJOB_PREFIX='"//subjob_prefix//"' len=",len + call getenv_withdefault("SUBJOB_PREFIX", "", subjob_prefix) + if (len(subjob_prefix) > 0) subjob_prefix = subjob_prefix//" " + end if + if (.not. allocated(fpm_driver)) then + call getenv_withdefault("FPM_DRIVER", "./build/run-fpm.sh", fpm_driver) end if call prif_sync_all() call prif_this_image_no_coarray(this_image=me) - result_ = (me == 1) .and. (subjob_prefix /= "skip") + result_ = (me == 1) .and. (trim(subjob_prefix) /= "skip") end function diff --git a/test/a00_caffeinate_test.F90 b/test/a00_caffeinate_test.F90 deleted file mode 100644 index 0f88428d..00000000 --- a/test/a00_caffeinate_test.F90 +++ /dev/null @@ -1,58 +0,0 @@ -module a00_caffeinate_test - use prif, only : prif_init, PRIF_STAT_ALREADY_INIT - use veggies, only: test_item_t, describe, result_t, it, assert_that - - implicit none - private - public :: test_caffeinate, check_caffeination - -contains - - function test_caffeinate() result(tests) - type(test_item_t) :: tests - - tests = describe( & - "A caffeinated beverage", & - [ it("is served: the prif_init() function completes successfully.", check_caffeination) & - , it("a subsequent prif_init call returns PRIF_STAT_ALREADY_INIT", & - check_subsequent_prif_init_call) & - ]) - end function - - function check_caffeination() result(result_) - ! this test needs to run very early at startup, so we memoize the result - type(result_t) :: result_ - type(result_t), save :: myresult - logical, save :: once = .false. - - if (once) then - result_ = myresult - return - endif - once = .true. - - 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) - myresult = assert_that(init_exit_code == successful_initiation) - result_ = myresult - end block - end function - - function check_subsequent_prif_init_call() result(result_) - type(result_t) :: result_ - - integer :: stat - - call prif_init(stat) - call prif_init(stat) - result_ = assert_that(stat == PRIF_STAT_ALREADY_INIT) - end function - -end module a00_caffeinate_test diff --git a/test/julienne-driver.F90 b/test/julienne-driver.F90 index 664a2406..f7405f4f 100644 --- a/test/julienne-driver.F90 +++ b/test/julienne-driver.F90 @@ -2,32 +2,67 @@ ! 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 julienne_m, only : test_fixture_t, test_harness_t, test_diagnosis_t + use prif_init_test_m, only : prif_init_test_t, check_caffeination + use prif_num_images_test_m, only : prif_num_images_test_t + use prif_this_image_no_coarray_test_m, only : prif_this_image_no_coarray_test_t + use prif_image_queries_test_m, only : prif_image_queries_test_t + use prif_types_test_m, only : prif_types_test_t use prif_co_broadcast_test_m, only : prif_co_broadcast_test_t + use prif_co_sum_test_m, only : prif_co_sum_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 + use prif_image_index_test_m, only : prif_image_index_test_t + use prif_allocate_test_m, only : prif_allocate_test_t + use prif_coarray_inquiry_test_m, only : prif_coarray_inquiry_test_t + use prif_teams_test_m, only : prif_teams_test_t + use prif_rma_test_m, only : prif_rma_test_t + use prif_strided_test_m, only : prif_strided_test_t + use prif_event_test_m, only : prif_event_test_t + use prif_image_queries_test_m, only : prif_image_queries_test_t + use prif_atomic_test_m, only : prif_atomic_test_t + use prif_error_stop_test_m, only : prif_error_stop_test_t + use prif_stop_test_m, only : prif_stop_test_t implicit none + type(test_diagnosis_t) :: dummy + dummy = check_caffeination() ! ensure an early call to prif_init + associate(test_harness => test_harness_t([ & - test_fixture_t( prif_init_test_t() ) & ! must come first + ! tests for basic functionality that are mostly self-contained + test_fixture_t( prif_init_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_types_test_t() ) & + + ! collectives tests ,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() ) & + + ! tests that rely primarily upon coarrays + ,test_fixture_t( prif_allocate_test_t() ) & ! should be first coarray test ,test_fixture_t( prif_coarray_inquiry_test_t() ) & - ,test_fixture_t( prif_sync_images_test_t() ) & + ,test_fixture_t( prif_image_index_test_t() ) & + ,test_fixture_t( prif_rma_test_t() ) & + ,test_fixture_t( prif_strided_test_t() ) & + + ! synchronization and data race tests + ,test_fixture_t( prif_event_test_t() ) & + ,test_fixture_t( prif_atomic_test_t() ) & + ,test_fixture_t( prif_sync_images_test_t() ) & ! internally uses coarrays and events + + ! complicated multi-feature tests + ,test_fixture_t( prif_teams_test_t() ) & + + ! exit tests + ,test_fixture_t( prif_error_stop_test_t() ) & + ,test_fixture_t( prif_stop_test_t() ) & ])) call test_harness%report_results end associate diff --git a/test/main.F90 b/test/main.F90 deleted file mode 100644 index 0581dbce..00000000 --- a/test/main.F90 +++ /dev/null @@ -1,96 +0,0 @@ -! This file was originally generated by cart, but then manually edited. -! DO NOT REGENERATE THIS FILE! -program main - use iso_c_binding, only : c_bool - use iso_fortran_env, only : OUTPUT_UNIT, ERROR_UNIT - use prif, only : & - prif_stop & - ,prif_error_stop - implicit none - - logical(kind=c_bool), parameter :: false = .false._c_bool - - if (.not.run()) call prif_error_stop(quiet=false, stop_code_char = "Unit tests failed to run") - - call prif_stop(quiet=false) - -contains - function run() result(passed) - use a00_caffeinate_test, only: & - check_caffeination, & - a00_caffeinate_caffeinate => & - test_caffeinate - use caf_allocate_test, only: & - caf_allocate_prif_allocate => & - test_prif_allocate - use caf_image_index_test, only: & - caf_image_index_prif_image_index => & - test_prif_image_index - use prif_types_test, only: test_prif_types - use caf_rma_test, only: & - caf_rma_prif_rma => & - test_prif_rma - use caf_strided_test, only: & - test_prif_rma_strided - use caf_event_test, only: & - test_prif_event - use caf_atomic_test, only: & - test_prif_atomic - use caf_teams_test, only: & - caf_teams_caf_teams => & - test_caf_teams - 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 - - - - logical :: passed - - type(test_item_t) :: tests - type(test_item_t), allocatable :: individual_tests(:) - type(result_t) :: dummy - - ! ensure an early call to prif_init - dummy = check_caffeination() - - allocate(individual_tests(0)) - -#if __flang__ && 0 /* currently no disabled tests */ - block - integer :: major, minor -# if defined(__flang_major__) && defined(__flang_minor__) - major = __flang_major__ - minor = __flang_minor__ -# else - major = -1 - minor = -1 -# endif - print *, "-----------------------------------------------------------------" - print *, "WARNING: flang-new compiler detected, version:",major,".",minor - print *, "WARNING: Skipping tests that are known to fail with this compiler" - print *, "-----------------------------------------------------------------" - call flush(OUTPUT_UNIT) - end block -#endif - individual_tests = [a00_caffeinate_caffeinate()] - individual_tests = [individual_tests, test_prif_types()] - individual_tests = [individual_tests, caf_allocate_prif_allocate()] - individual_tests = [individual_tests, caf_image_index_prif_image_index()] - 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, test_prif_atomic()] - individual_tests = [individual_tests, test_prif_event()] - individual_tests = [individual_tests, test_prif_stop()] - individual_tests = [individual_tests, test_prif_error_stop()] - - tests = test_that(individual_tests) - - call flush(OUTPUT_UNIT) - call flush(ERROR_UNIT) - - passed = run_tests(tests) - - end function -end program diff --git a/test/prif_allocate_test.F90 b/test/prif_allocate_test.F90 index e9309314..e6bfc2ca 100644 --- a/test/prif_allocate_test.F90 +++ b/test/prif_allocate_test.F90 @@ -1,4 +1,6 @@ -module caf_allocate_test +#include "test-utils.F90" + +module prif_allocate_test_m use prif, only : & prif_allocate_coarray, & prif_allocate, prif_deallocate, & @@ -12,33 +14,45 @@ module caf_allocate_test #else use prif, only : prif_deallocate_coarray, prif_deallocate_coarrays #endif - use veggies, only: result_t, test_item_t, assert_that, assert_equals, describe, it, succeed + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, string_t, usher & + ,operator(.all.), operator(.also.), operator(.equalsExpected.), operator(//) use iso_c_binding, only: & - c_ptr, c_int, c_int64_t, c_size_t, c_funptr, c_null_funptr, & - c_f_pointer, c_null_ptr, c_loc, c_sizeof, c_associated, c_intptr_t + c_ptr, c_int, c_int64_t, c_size_t, c_null_funptr, & + c_f_pointer, c_null_ptr, c_loc, c_associated, c_intptr_t implicit none private - public :: test_prif_allocate + public :: prif_allocate_test_t + + type, extends(test_t) :: prif_allocate_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type contains - function test_prif_allocate() result(tests) - type(test_item_t) :: tests - - tests = & - describe( & - "PRIF allocation can", & - [ it("allocate, use and deallocate an integer scalar coarray with a corank of 1", & - check_allocate_integer_scalar_coarray_with_corank1) & - , it("allocate, use and deallocate an integer array coarray with a corank of 2", & - check_allocate_integer_array_coarray_with_corank2) & - , it("allocate, use and deallocate memory non-symmetrically", & - check_allocate_non_symmetric) & - ]) + + pure function subject() + character(len=:), allocatable :: subject + subject = "PRIF Allocation" end function - function check_allocate_integer_scalar_coarray_with_corank1() result(result_) - type(result_t) :: result_ + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_allocate_test_t) prif_allocate_test + + allocate(test_results, source = prif_allocate_test%run([ & + test_description_t("allocating, using and deallocating an integer scalar coarray with a corank of 1", & + usher(check_allocate_integer_scalar_coarray_with_corank1)) & + ,test_description_t("allocating, using and deallocating an integer array coarray with a corank of 2", & + usher(check_allocate_integer_array_coarray_with_corank2)) & + ,test_description_t("allocating, using and deallocating memory non-symmetrically", & + usher(check_allocate_non_symmetric)) & + ])) + end function + + function check_allocate_integer_scalar_coarray_with_corank1() result(diag) + type(test_diagnosis_t) diag ! Allocate memory for an integer scalar single corank coarray, such as the following decl ! integer :: coarr[*] @@ -50,13 +64,15 @@ function check_allocate_integer_scalar_coarray_with_corank1() result(result_) integer, pointer :: local_slice 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 allocated_memory = c_null_ptr local_slice => null() - result_ = assert_that(.not.associated(local_slice)) + ALSO(.not. associated(local_slice)) data_size = storage_size(dummy_element)/8 call prif_allocate_coarray( & @@ -64,13 +80,13 @@ function check_allocate_integer_scalar_coarray_with_corank1() result(result_) coarray_handle, allocated_memory) call c_f_pointer(allocated_memory, local_slice) - result_ = result_ .and. assert_that(associated(local_slice)) + ALSO(associated(local_slice)) local_slice = 42 - result_ = result_ .and. assert_equals(42, local_slice) + ALSO(local_slice .equalsExpected. 42) call prif_size_bytes(coarray_handle, data_size=query_size) - result_ = result_ .and. assert_that(query_size == data_size, "prif_size_bytes is valid") + ALSO2(query_size .equalsExpected. data_size, "invalid prif_size_bytes") block ! Check prif_{set,get}_context_data integer, target :: dummy(10), i @@ -80,8 +96,7 @@ function check_allocate_integer_scalar_coarray_with_corank1() result(result_) actual = c_null_ptr call prif_set_context_data(coarray_handle, expect) call prif_get_context_data(coarray_handle, actual) - result_ = result_ .and. & - assert_that(c_associated(expect, actual), "prif_{set,get}_context_data are working") + ALSO2(actual .equalsExpected. expect, "prif_{set,get}_context_data are not working") end do end block @@ -89,8 +104,8 @@ function check_allocate_integer_scalar_coarray_with_corank1() result(result_) end function - function check_allocate_non_symmetric() result(result_) - type(result_t) :: result_ + function check_allocate_non_symmetric() result(diag) + type(test_diagnosis_t) diag type(c_ptr) :: allocated_memory integer(c_int), pointer :: local_slice @@ -99,7 +114,7 @@ function check_allocate_non_symmetric() result(result_) call c_f_pointer(allocated_memory, local_slice) local_slice = 42 - result_ = assert_equals(42, local_slice) + diag = local_slice .equalsExpected. 42 call prif_deallocate(c_loc(local_slice)) end function @@ -116,8 +131,8 @@ pure function c_ptr_add(p, off) c_ptr_add = transfer(tmp, c_ptr_add) end function - function assert_aliased(h1, h2, offset) result(result_) - type(result_t) :: result_ + function assert_aliased(h1, h2, offset) result(diag) + type(test_diagnosis_t) :: diag type(prif_coarray_handle) :: h1, h2 integer(c_size_t), optional :: offset integer(c_size_t) :: offset_ @@ -127,7 +142,7 @@ function assert_aliased(h1, h2, offset) result(result_) integer, save, target :: dummy(10) integer, save :: di = 1 - result_ = succeed("") + diag = .true. if (present(offset)) then offset_ = offset @@ -137,37 +152,32 @@ function assert_aliased(h1, h2, offset) result(result_) call prif_local_data_pointer(h1, p1) call prif_local_data_pointer(h2, p2) - result_ = result_ .and. & - assert_that(c_associated(c_ptr_add(p1, offset_), p2)) + ALSO(p2 .equalsExpected. c_ptr_add(p1, offset_)) ! As of PRIF 0.6. prif_size_bytes is unspecified for aliases, ! so this particular check is specific to the current Caffeine implementation call prif_size_bytes(h1, s1) call prif_size_bytes(h2, s2) - result_ = result_ .and. & - assert_equals(int(s1), int(s2)) - + ALSO(s2 .equalsExpected. s1) + cx = c_loc(dummy(di)) di = mod(di,size(dummy)) + 1 call prif_set_context_data(h1, cx) call prif_get_context_data(h1, c1) - result_ = result_ .and. & - assert_that(c_associated(c1, cx)) + ALSO(c1 .equalsExpected. cx) call prif_get_context_data(h2, c2) - result_ = result_ .and. & - assert_that(c_associated(c2, cx)) - + ALSO(c2 .equalsExpected. cx) + call prif_set_context_data(h2, c_null_ptr) call prif_get_context_data(h1, c1) - result_ = result_ .and. & - assert_that(.not. c_associated(c1)) + ALSO(.not. c_associated(c1)) end function - function check_allocate_integer_array_coarray_with_corank2() result(result_) - type(result_t) :: result_ + function check_allocate_integer_array_coarray_with_corank2() result(diag) + type(test_diagnosis_t) :: diag ! Allocate memory for an integer scalar single corank coarray, such as the following decl ! integer :: coarr(10)[4,*] @@ -179,6 +189,8 @@ function check_allocate_integer_array_coarray_with_corank2() result(result_) integer, pointer :: local_slice(:) integer(c_size_t) :: data_size, query_size + diag = .true. + call prif_num_images(num_images=num_imgs) lcobounds(1) = 1 ucobounds(1) = 4 @@ -187,7 +199,7 @@ function check_allocate_integer_array_coarray_with_corank2() result(result_) allocated_memory = c_null_ptr local_slice => null() - result_ = assert_that(.not.associated(local_slice)) + ALSO(.not.associated(local_slice)) data_size = 10*storage_size(dummy_element)/8 call prif_allocate_coarray( & @@ -195,15 +207,14 @@ function check_allocate_integer_array_coarray_with_corank2() result(result_) coarray_handle, 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") + ALSO2(query_size .equalsExpected. data_size, "invalid prif_size_bytes") call c_f_pointer(allocated_memory, local_slice, [10]) - result_ = result_ .and. assert_that(associated(local_slice)) + ALSO(associated(local_slice)) + + local_slice = [(i*i, i = 1, 10)] + ALSO(.all. (local_slice .equalsExpected. [(i*i, i = 1, 10)])) - local_slice = [(i*i, i = 1, 10)] - do i = 1,10 - result_ = result_ .and. assert_equals(i*i, local_slice(i)) - end do block ! Check prif_{set,get}_context_data integer, target :: dummy(10), i @@ -213,8 +224,7 @@ function check_allocate_integer_array_coarray_with_corank2() result(result_) actual = c_null_ptr call prif_set_context_data(coarray_handle, expect) call prif_get_context_data(coarray_handle, actual) - result_ = result_ .and. & - assert_that(c_associated(expect, actual), "prif_{set,get}_context_data are working") + ALSO2(actual .equalsExpected. expect, "prif_{set,get}_context_data not working") end do end block @@ -233,16 +243,13 @@ function check_allocate_integer_array_coarray_with_corank2() result(result_) lco(1) = i uco(1) = i + num_imgs call prif_alias_create(a(i-1), lco, uco, data_pointer_offset a(i)) - result_ = result_ .and. & - assert_aliased(a(i-1), a(i)) + ALSO(assert_aliased(a(i-1), a(i))) do j = i+1,lim lco(1) = j uco(1) = j + num_imgs call prif_alias_create(a(i), lco, uco, data_pointer_offset a(j)) - result_ = result_ .and. & - assert_aliased(a(i), a(j)) - result_ = result_ .and. & - assert_aliased(a(j), coarray_handle) + ALSO(assert_aliased(a(i), a(j))) + ALSO(assert_aliased(a(j), coarray_handle)) end do # if !FORCE_PRIF_0_5 ! test PRIF 0.6 data_pointer_offset @@ -251,8 +258,7 @@ function check_allocate_integer_array_coarray_with_corank2() result(result_) integer(c_size_t) :: off off = i call prif_alias_create(a(i), lco, uco, off, b) - result_ = result_ .and. & - assert_aliased(a(i), b, off) + ALSO(assert_aliased(a(i), b, off)) call prif_alias_destroy(b) end block # endif @@ -268,4 +274,4 @@ function check_allocate_integer_array_coarray_with_corank2() result(result_) call prif_deallocate_coarray(coarray_handle) end function -end module caf_allocate_test +end module prif_allocate_test_m diff --git a/test/prif_atomic_test.F90 b/test/prif_atomic_test.F90 index 14a2b4de..9128358e 100644 --- a/test/prif_atomic_test.F90 +++ b/test/prif_atomic_test.F90 @@ -1,10 +1,11 @@ -#include "assert_macros.h" +#include "julienne-assert-macros.h" +#include "test-utils.F90" -module caf_atomic_test - use assert_m +module prif_atomic_test_m use iso_c_binding, only: & c_ptr, c_int64_t, c_intptr_t, c_size_t, c_null_funptr, c_f_pointer, c_loc, c_sizeof - use veggies, only: result_t, test_item_t, assert_equals, assert_that, describe, it, succeed + use julienne_m, only: call_julienne_assert_, test_description_t, test_diagnosis_t, test_result_t, test_t, string_t, usher & + ,operator(.also.), operator(.equalsExpected.), operator(.isAtLeast.), operator(.isAtMost.), operator(.lessThan.), operator(//) use prif #if FORCE_PRIF_0_5 || FORCE_PRIF_0_6 use prif, only : prif_deallocate_coarray_ => prif_deallocate_coarray @@ -14,16 +15,40 @@ module caf_atomic_test implicit none private - public :: test_prif_atomic + public :: prif_atomic_test_t + + type, extends(test_t) :: prif_atomic_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type + + ! define an .equalsExpected. for logical(PRIF_ATOMIC_LOGICAL_KIND) + interface operator(.equalsExpected.) + module procedure prif_logical_equals + end interface operator(.equalsExpected.) contains - function test_prif_atomic() result(tests) - type(test_item_t) :: tests - - tests = describe( & - "PRIF atomics", & - [ it("pass uncontended atomic test", check_atomic_uncontended) & - , it("pass contended hot-spot atomic test", check_atomic_contended) & - ]) + pure function prif_logical_equals(lhs, rhs) result(diag) + logical(PRIF_ATOMIC_LOGICAL_KIND), intent(in) :: lhs, rhs + type(test_diagnosis_t) :: diag + + diag = test_diagnosis_t(logical(lhs .eqv. rhs), & + string_t("expected ") // merge('T','F',rhs) // "; actual value is " // merge('T','F',lhs)) + end function prif_logical_equals + + pure function subject() + character(len=:), allocatable :: subject + subject = "PRIF Atomics" + end function + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_atomic_test_t) prif_atomic_test + + allocate(test_results, source = prif_atomic_test%run([ & + test_description_t("an uncontended atomic test", usher(check_atomic_uncontended)) & + , test_description_t("a contended hot-spot atomic test", usher(check_atomic_contended)) & + ])) end function subroutine test_srand(seed) @@ -42,37 +67,11 @@ function test_rand(lo, hi) result(result_) real :: r call random_number(r) ! Generate a uniform random number in [0, 1) result_ = int(r * (hi - lo + 1)) + lo - call_assert(result_ >= lo .and. result_ <= hi) - end function - - function assert_equals_int(expect, actual, desc) result(result_) - integer(PRIF_ATOMIC_INT_KIND), intent(in) :: expect, actual - character(len=*), intent(in) :: desc - type(result_t) :: result_ - - ! TODO: would like a 64-bit integer compare, but our current - ! veggies version does not yet support that. - if (expect == int(expect) .and. actual == int(actual)) then - ! safe to truncate - result_ = assert_equals(int(expect), int(actual), desc) - else - result_ = assert_that(expect == actual, desc) - endif - end function - - function assert_equals_logical(expect, actual, desc) result(result_) - logical(PRIF_ATOMIC_LOGICAL_KIND), intent(in) :: expect, actual - character(len=*), intent(in) :: desc - type(result_t) :: result_ - character(len=:), allocatable :: expect_str, actual_str - expect_str = merge(".true. ",".false.",expect) - actual_str = merge(".true. ",".false.",actual) - - result_ = assert_equals(expect_str, actual_str, desc) + call_julienne_assert((result_ .isAtLeast. lo) .also. (result_ .isAtMost. hi)) end function - function check_atomic_uncontended() result(result_) - type(result_t) :: result_ + function check_atomic_uncontended() result(diag) + type(test_diagnosis_t) :: diag integer, parameter :: lim = 100 integer :: me, num_imgs, peer, i @@ -84,13 +83,13 @@ function check_atomic_uncontended() result(result_) integer(c_intptr_t) :: base_addr_int, base_addr_logical - result_ = succeed("") + diag = .true. sizeof_atomic_int = int(storage_size(dummy_atomic_int)/8, c_size_t) sizeof_atomic_logical = int(storage_size(dummy_atomic_logical)/8, c_size_t) ! Check an invariant of the current Caffeine impl, not required by PRIF: - call_assert(sizeof_atomic_int == 8) - call_assert(sizeof_atomic_logical == 8) + call_julienne_assert(sizeof_atomic_int .equalsExpected. 8_c_size_t) + call_julienne_assert(sizeof_atomic_logical .equalsExpected. 8_c_size_t) call prif_num_images(num_images=num_imgs) call prif_this_image_no_coarray(this_image=me) @@ -131,39 +130,32 @@ function check_atomic_uncontended() result(result_) expect_int = me call prif_atomic_define_int(me, coarray_handle_int, 0_c_size_t, value=expect_int) call prif_atomic_ref_int(me, coarray_handle_int, 0_c_size_t, value=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "local define direct / ref direct") + ALSO2(value_int .equalsExpected. expect_int, "local define direct / ref direct") call prif_atomic_ref_int_indirect(me, base_addr_int, value=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "local define direct / ref indirect") + ALSO2(value_int .equalsExpected. expect_int, "local define direct / ref indirect") expect_int = me * 100 call prif_atomic_define_int_indirect(me, base_addr_int, value=expect_int) call prif_atomic_ref_int_indirect(me, base_addr_int, value=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "local define indirect / ref indirect") + ALSO2(value_int .equalsExpected. expect_int, "local define indirect / ref indirect") call prif_atomic_cas_int(me, coarray_handle_int, 0_c_size_t, & old=value_int, compare=expect_int, new=(expect_int*10)) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "local cas direct") + ALSO2(value_int .equalsExpected. expect_int, "local cas direct") expect_int = expect_int * 10 call prif_atomic_cas_int_indirect(me, base_addr_int, & old=value_int, compare=expect_int, new=(expect_int*10)) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "local cas indirect") + ALSO2(value_int .equalsExpected. expect_int, "local cas indirect") expect_int = expect_int * 10 call prif_atomic_ref_int(me, coarray_handle_int, 0_c_size_t, value=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "local cas / ref direct") + ALSO2(value_int .equalsExpected. expect_int, "local cas / ref direct") expect_int = 0 call prif_atomic_define_int(me, coarray_handle_int, 0_c_size_t, value=expect_int) call prif_atomic_ref_int(me, coarray_handle_int, 0_c_size_t, value=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "local define direct / ref direct (final)") + ALSO2(value_int .equalsExpected. expect_int, "local define direct / ref direct (final)") call prif_sync_all() ! only here for subtest isolation @@ -172,39 +164,32 @@ function check_atomic_uncontended() result(result_) expect_logical = (IOR(me,1) == 1) call prif_atomic_define_logical(me, coarray_handle_logical, 0_c_size_t, value=expect_logical) call prif_atomic_ref_logical(me, coarray_handle_logical, 0_c_size_t, value=value_logical) - result_ = result_ .and. & - assert_equals_logical(expect_logical, value_logical, "local define direct / ref direct") + ALSO2(value_logical .equalsExpected. expect_logical, "local define direct / ref direct)") call prif_atomic_ref_logical_indirect(me, base_addr_logical, value=value_logical) - result_ = result_ .and. & - assert_equals_logical(expect_logical, value_logical, "local define direct / ref indirect") + ALSO2(value_logical .equalsExpected. expect_logical, "local define direct / ref indirect") expect_logical = .not. expect_logical call prif_atomic_define_logical_indirect(me, base_addr_logical, value=expect_logical) call prif_atomic_ref_logical_indirect(me, base_addr_logical, value=value_logical) - result_ = result_ .and. & - assert_equals_logical(expect_logical, value_logical, "local define indirect / ref indirect") + ALSO2(value_logical .equalsExpected. expect_logical, "local define indirect / ref indirect") call prif_atomic_cas_logical(me, coarray_handle_logical, 0_c_size_t, & old=value_logical, compare=expect_logical, new=(.not. expect_logical)) - result_ = result_ .and. & - assert_equals_logical(expect_logical, value_logical, "local cas direct") + ALSO2(value_logical .equalsExpected. expect_logical, "local cas direct") expect_logical = .not. expect_logical call prif_atomic_cas_logical_indirect(me, base_addr_logical, & old=value_logical, compare=expect_logical, new=(.not. expect_logical)) - result_ = result_ .and. & - assert_equals_logical(expect_logical, value_logical, "local cas indirect") + ALSO2(value_logical .equalsExpected. expect_logical, "local cas indirect") expect_logical = .not. expect_logical call prif_atomic_ref_logical(me, coarray_handle_logical, 0_c_size_t, value=value_logical) - result_ = result_ .and. & - assert_equals_logical(expect_logical, value_logical, "local cas / ref direct") + ALSO2(value_logical .equalsExpected. expect_logical, "local cas / ref direct") expect_logical = .false. call prif_atomic_define_logical(me, coarray_handle_logical, 0_c_size_t, value=expect_logical) call prif_atomic_ref_logical(me, coarray_handle_logical, 0_c_size_t, value=value_logical) - result_ = result_ .and. & - assert_equals_logical(expect_logical, value_logical, "local define direct / ref direct (final)") + ALSO2(value_logical .equalsExpected. expect_logical, "local define direct / ref direct (final)") end do @@ -212,8 +197,8 @@ function check_atomic_uncontended() result(result_) ! uncontended test targeting peer's location - call_assert(expect_int == 0) - call_assert(logical(expect_logical .eqv. .false.)) + call_julienne_assert(expect_int .equalsExpected. 0_c_size_t) + call_julienne_assert(logical(expect_logical .eqv. .false.)) peer = mod(me,num_imgs)+1 @@ -233,21 +218,18 @@ function check_atomic_uncontended() result(result_) case (2) ; test_desc = "cas succeed" call prif_atomic_cas_logical(peer, coarray_handle_logical, 0_c_size_t, & old=value_logical, compare=expect_logical, new=tmp) - result_ = result_ .and. & - assert_equals_logical(expect_logical, value_logical, "int cas direct succeed") + ALSO2(value_logical .equalsExpected. expect_logical, "int cas direct succeed") expect_logical = tmp case (3) ; test_desc = "cas fail" call prif_atomic_cas_logical(peer, coarray_handle_logical, 0_c_size_t, & old=value_logical, compare=(.not. expect_logical), new=tmp) - result_ = result_ .and. & - assert_equals_logical(expect_logical, value_logical, "int cas direct fail") + ALSO2(value_logical .equalsExpected. expect_logical, "int cas direct fail") end select call prif_atomic_ref_logical(peer, coarray_handle_logical, 0_c_size_t, value=value_logical) - result_ = result_ .and. & - assert_equals_logical(expect_logical, value_logical, "result check for peer int "//test_desc) + ALSO2(value_logical .equalsExpected. expect_logical, "result check for peer int "//test_desc) end block end do @@ -269,15 +251,13 @@ function check_atomic_uncontended() result(result_) case (2) ; test_desc = "cas succeed" call prif_atomic_cas_int(peer, coarray_handle_int, 0_c_size_t, & old=value_int, compare=expect_int, new=tmp) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "int cas direct succeed") + ALSO2(value_int .equalsExpected. expect_int, "int cas direct succeed") expect_int = tmp case (3) ; test_desc = "cas fail" call prif_atomic_cas_int(peer, coarray_handle_int, 0_c_size_t, & old=value_int, compare=expect_int+1, new=tmp) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "int cas direct fail") + ALSO2(value_int .equalsExpected. expect_int, "int cas direct fail") case (4) ; test_desc = "add" call prif_atomic_add(peer, coarray_handle_int, 0_c_size_t, value=tmp) @@ -285,8 +265,7 @@ function check_atomic_uncontended() result(result_) case (5) ; test_desc = "fetch_add" call prif_atomic_fetch_add(peer, coarray_handle_int, 0_c_size_t, value=tmp, old=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "fetch_add fetch check") + ALSO2(value_int .equalsExpected. expect_int, "fetch_add fetch check") expect_int = expect_int + tmp case (6) ; test_desc = "and" @@ -295,8 +274,7 @@ function check_atomic_uncontended() result(result_) case (7) ; test_desc = "fetch_and" call prif_atomic_fetch_and(peer, coarray_handle_int, 0_c_size_t, value=tmp, old=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "fetch_and fetch check") + ALSO2(value_int .equalsExpected. expect_int, "fetch_and fetch check") expect_int = IAND(expect_int, tmp) case (8) ; test_desc = "or" @@ -305,8 +283,7 @@ function check_atomic_uncontended() result(result_) case (9) ; test_desc = "fetch_or" call prif_atomic_fetch_or(peer, coarray_handle_int, 0_c_size_t, value=tmp, old=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "fetch_or fetch check") + ALSO2(value_int .equalsExpected. expect_int, "fetch_or fetch check") expect_int = IOR(expect_int, tmp) case (10) ; test_desc = "xor" @@ -315,16 +292,14 @@ function check_atomic_uncontended() result(result_) case (11) ; test_desc = "fetch_xor" call prif_atomic_fetch_xor(peer, coarray_handle_int, 0_c_size_t, value=tmp, old=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "fetch_xor fetch check") + ALSO2(value_int .equalsExpected. expect_int, "fetch_xor fetch check") expect_int = IEOR(expect_int, tmp) end select call prif_atomic_ref_int(peer, coarray_handle_int, 0_c_size_t, value=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, "result check for peer int "//test_desc) + ALSO2(value_int .equalsExpected. expect_int, "result check for peer int "//test_desc) end block end do @@ -333,8 +308,8 @@ function check_atomic_uncontended() result(result_) call prif_deallocate_coarrays(([coarray_handle_int,coarray_handle_logical])) end function - function check_atomic_contended() result(result_) - type(result_t) :: result_ + function check_atomic_contended() result(diag) + type(test_diagnosis_t) diag integer, parameter :: lim = 100 integer :: me, num_imgs, root, i @@ -349,7 +324,7 @@ function check_atomic_contended() result(result_) logical(PRIF_ATOMIC_LOGICAL_KIND) :: value_logical, expect_logical, tmp_logical character(len=:),allocatable :: desc - result_ = succeed("") + diag = .true. sizeof_atomic_int = int(storage_size(dummy_atomic_int)/8, c_size_t) sizeof_atomic_logical = int(storage_size(dummy_atomic_logical)/8, c_size_t) @@ -381,17 +356,14 @@ function check_atomic_contended() result(result_) call prif_atomic_add_indirect(root, base_addr_int, value=plus_one) call prif_atomic_add_indirect(root, base_addr_int, value=minus_one) call prif_atomic_fetch_add_indirect(root, base_addr_int, value=plus_one, old=value_int) - result_ = result_ .and. & - assert_that(value_int >= expect_int, desc//"mid-increment lower bound") - result_ = result_ .and. & - assert_that(value_int < expect_int + num_imgs, desc//"mid-increment upper bound") + ALSO2(value_int .isAtLeast. expect_int, desc//"mid-increment lower bound") + ALSO2(value_int .lessThan. (expect_int + num_imgs), desc//"mid-increment upper bound") call prif_sync_all() expect_int = expect_int + num_imgs call prif_atomic_ref_int_indirect(root, base_addr_int, value=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, desc//"loop-bottom check") + ALSO2(value_int .equalsExpected. expect_int, desc//"loop-bottom check") end do @@ -404,10 +376,8 @@ function check_atomic_contended() result(result_) do call prif_atomic_cas_int_indirect(root, base_addr_int, & old=value_int, compare=tmp_int, new=(tmp_int+1)) - result_ = result_ .and. & - assert_that(value_int >= expect_int, desc//"mid-increment lower bound") - result_ = result_ .and. & - assert_that(value_int < expect_int + num_imgs, desc//"mid-increment upper bound") + ALSO2(value_int .isAtLeast. expect_int, desc//"mid-increment lower bound") + ALSO2(value_int .lessThan. (expect_int + num_imgs), desc//"mid-increment upper bound") if (value_int == tmp_int) exit ! success tmp_int = value_int ! collision => retry end do @@ -416,8 +386,7 @@ function check_atomic_contended() result(result_) expect_int = expect_int + num_imgs call prif_atomic_ref_int_indirect(root, base_addr_int, value=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, value_int, desc//"loop-bottom check") + ALSO2(value_int .equalsExpected. expect_int, desc//"loop-bottom check") end do @@ -432,8 +401,7 @@ function check_atomic_contended() result(result_) call prif_atomic_cas_logical_indirect(root, base_addr_logical, & old=value_logical, compare=tmp_logical, new=(.not. tmp_logical)) if (value_logical .eqv. tmp_logical) exit ! success - result_ = result_ .and. & - assert_equals_logical(value_logical, .not. tmp_logical, desc//"mid-swap sanity check") + ALSO2(logical(value_logical .eqv. .not. tmp_logical), desc//"mid-swap sanity check") tmp_logical = value_logical ! collision => retry end do @@ -441,8 +409,7 @@ function check_atomic_contended() result(result_) expect_logical = merge(expect_logical, .not. expect_logical, mod(num_imgs,2) == 0) call prif_atomic_ref_logical_indirect(root, base_addr_logical, value=value_logical) - result_ = result_ .and. & - assert_equals_logical(expect_logical, value_logical, desc//"loop-bottom check") + ALSO2(value_logical .equalsExpected. expect_logical, desc//"loop-bottom check") end do call prif_sync_all() @@ -469,8 +436,7 @@ function check_atomic_contended() result(result_) case (2) ; test_desc = "fetch_and" call prif_atomic_fetch_and_indirect(root, base_addr_int, value=NOT(my_bit), old=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, IAND(value_int,my_bit), desc//"fetch_and fetch check") + ALSO2(IAND(value_int,my_bit) .equalsExpected. expect_int, desc//"fetch_and fetch check") expect_int = IAND(expect_int, NOT(my_bit)) case (3) ; test_desc = "or" @@ -479,8 +445,7 @@ function check_atomic_contended() result(result_) case (4) ; test_desc = "fetch_or" call prif_atomic_fetch_or_indirect(root, base_addr_int, value=my_bit, old=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, IAND(value_int,my_bit), desc//"fetch_or fetch check") + ALSO2(IAND(value_int,my_bit) .equalsExpected. expect_int, desc//"fetch_or fetch check") expect_int = IOR(expect_int, my_bit) case (5) ; test_desc = "xor" @@ -489,16 +454,14 @@ function check_atomic_contended() result(result_) case (6) ; test_desc = "fetch_xor" call prif_atomic_fetch_xor_indirect(root, base_addr_int, value=my_bit, old=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, IAND(value_int,my_bit), desc//"fetch_xor fetch check") + ALSO2(IAND(value_int,my_bit) .equalsExpected. expect_int, desc//"fetch_xor fetch check") expect_int = IEOR(expect_int, my_bit) end select call prif_atomic_ref_int_indirect(root, base_addr_int, value=value_int) - result_ = result_ .and. & - assert_equals_int(expect_int, IAND(value_int,my_bit), desc//"result check for int "//test_desc) + ALSO2(IAND(value_int,my_bit) .equalsExpected. expect_int, desc//"result check for int "//test_desc) end block end do diff --git a/test/prif_co_broadcast_test.F90 b/test/prif_co_broadcast_test.F90 index 3ba12c5c..3a93da58 100644 --- a/test/prif_co_broadcast_test.F90 +++ b/test/prif_co_broadcast_test.F90 @@ -42,10 +42,10 @@ 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([ & + allocate(test_results, source = prif_co_broadcast_test%run([ & test_description_t("broadcasting a default integer scalar with no optional arguments present", usher(broadcast_default_integer_scalar)) & ,test_description_t("broadcasting a derived type scalar with no allocatable components", usher(broadcast_derived_type)) & - ]) + ])) end function logical pure function equals(lhs, rhs) diff --git a/test/prif_co_max_test.F90 b/test/prif_co_max_test.F90 index e66cfe1c..44d8c01b 100644 --- a/test/prif_co_max_test.F90 +++ b/test/prif_co_max_test.F90 @@ -34,7 +34,7 @@ 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([ & + allocate(test_results, source = 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)) & @@ -43,7 +43,7 @@ function results() result(test_results) ,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(diag) @@ -60,7 +60,7 @@ function check_default_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_8_bit_integer() result(diag) diff --git a/test/prif_co_min_test.F90 b/test/prif_co_min_test.F90 index aff0a120..6f1a27bd 100644 --- a/test/prif_co_min_test.F90 +++ b/test/prif_co_min_test.F90 @@ -32,7 +32,7 @@ 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([ & + allocate(test_results, source = 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)) & @@ -41,7 +41,7 @@ function results() result(test_results) ,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(diag) @@ -109,7 +109,7 @@ function check_32_bit_integer() result(diag) call prif_co_min(my_val) expected = minval([(values(mod(i-1,size(values))+1), i = 1, ni)]) - diag = int(my_val) .equalsExpected. int(expected) + diag = my_val .equalsExpected. expected end function function check_64_bit_integer() result(diag) diff --git a/test/prif_co_reduce_test.F90 b/test/prif_co_reduce_test.F90 index 26f3483a..954b799d 100644 --- a/test/prif_co_reduce_test.F90 +++ b/test/prif_co_reduce_test.F90 @@ -1,3 +1,5 @@ +#include "test-utils.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 @@ -6,9 +8,10 @@ module prif_co_reduce_test_m ,operator(.also.) & ,operator(.approximates.) & ,operator(.equalsExpected.) & - ,operator(.expect.) & ,operator(.within.) & + ,operator(//) & ,usher & + ,string_t & ,test_description_t & ,test_diagnosis_t & ,test_result_t & @@ -52,13 +55,13 @@ 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([ & + allocate(test_results, source = 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 ,test_description_t("performing a parameterized derived type reduction", usher(check_type_parameter_reduction)) & #endif - ]) + ])) end function function check_logical() result(diag) @@ -71,16 +74,14 @@ function check_logical() result(diag) val = .true. call prif_co_reduce(val, op, c_null_ptr) - diag = diag .also. & - .expect. val + ALSO(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) - diag = diag .also. & - .expect. (.not. val) + ALSO(.not. val) end function subroutine and_wrapper(arg1, arg2_and_out, count, cdata) bind(C) diff --git a/test/prif_co_sum_test.F90 b/test/prif_co_sum_test.F90 index 0ca8ab99..82ccd7aa 100644 --- a/test/prif_co_sum_test.F90 +++ b/test/prif_co_sum_test.F90 @@ -34,7 +34,7 @@ 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([ & + allocate(test_results, source = 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)) & @@ -44,7 +44,7 @@ function results() result(test_results) ,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) @@ -112,7 +112,7 @@ function check_32_bit_integer() result(diag) call prif_co_sum(my_val) expected = sum([(values(mod(i-1,size(values))+1), i = 1, ni)]) - diag = int(my_val) .equalsExpected. int(expected) + diag = my_val .equalsExpected. expected end function function check_64_bit_integer() result(diag) diff --git a/test/prif_coarray_inquiry_test.F90 b/test/prif_coarray_inquiry_test.F90 index 7d3ddcdb..8b64a463 100644 --- a/test/prif_coarray_inquiry_test.F90 +++ b/test/prif_coarray_inquiry_test.F90 @@ -1,3 +1,5 @@ +#include "test-utils.F90" + module prif_coarray_inquiry_test_m use prif, only : & prif_allocate_coarray, prif_deallocate_coarray, & @@ -18,8 +20,8 @@ module prif_coarray_inquiry_test_m ,operator(.all.) & ,operator(.also.) & ,operator(.equalsExpected.) & - ,operator(.expect.) & ,usher & + ,string_t & ,test_description_t & ,test_diagnosis_t & ,test_result_t & @@ -41,17 +43,17 @@ module prif_coarray_inquiry_test_m pure function subject() result(test_subject) character(len=:), allocatable :: test_subject - test_subject = "PRIF coarray inquiry procedures" + test_subject = "PRIF Coarray Inquiries" 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([ & + allocate(test_results, source = 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) @@ -74,7 +76,7 @@ function check_prif_local_data_pointer() result(diag) coarray_handle, & allocation_ptr) call prif_local_data_pointer(coarray_handle, local_ptr) - diag = .expect. c_associated(local_ptr, allocation_ptr) + diag = c_associated(local_ptr, allocation_ptr) call prif_deallocate_coarray(coarray_handle) end function @@ -110,34 +112,27 @@ impure elemental function check_cobound(corank) result(diag) lcobounds, ucobounds, data_size, c_null_funptr, & coarray_handle, allocated_memory) - diag = diag .also. & - .expect. c_associated(allocated_memory) + ALSO(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" + ALSO2(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" + ALSO2(.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" + ALSO2(.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" + ALSO2(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" + ALSO2(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" + ALSO2(.all. ((ucobounds - lcobounds + 1) .equalsExpected. sizes), "prif_coshape is valid") call prif_deallocate_coarray(coarray_handle) end function diff --git a/test/prif_error_stop_test.F90 b/test/prif_error_stop_test.F90 index 84854103..45d3d71d 100644 --- a/test/prif_error_stop_test.F90 +++ b/test/prif_error_stop_test.F90 @@ -1,29 +1,41 @@ -module caf_error_stop_test - use prif, only: prif_this_image_no_coarray, prif_sync_all - use veggies, only: test_item_t, describe, result_t, it, assert_that, assert_equals, succeed +module prif_error_stop_test_m use unit_test_parameters_m, only : expected_error_stop_code, & - image_one => subjob_setup, cmd_prefix => subjob_prefix + image_one => subjob_setup, cmd_prefix => subjob_prefix, fpm_driver + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, usher & + ,operator(.expect.), operator(.equalsExpected.), operator(//) implicit none private - public :: test_prif_error_stop + public :: prif_error_stop_test_t + + type, extends(test_t) :: prif_error_stop_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type integer, parameter :: max_message_len = 128 contains - function test_prif_error_stop() result(tests) - type(test_item_t) :: tests - - tests = describe( & - "A program that executes the prif_error_stop function", & - [ it("exits with a non-zero exitstat when the program omits the stop code", exit_with_no_stop_code) & - ,it("prints a character stop code and exits with a non-zero exitstat", exit_with_character_stop_code) & - ,it("prints an integer stop code and exits with exitstat equal to the stop code", exit_with_integer_stop_code) & - ]) + + pure function subject() + character(len=:), allocatable :: subject + subject = "prif_error_stop" + end function + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_error_stop_test_t) prif_error_stop_test + + allocate(test_results, source = prif_error_stop_test%run([ & + test_description_t("delivering a non-zero exitstat when the stop code is omitted", usher(exit_with_no_stop_code)) & + ,test_description_t("printing a character stop code and delivering a non-zero exitstat", usher(exit_with_character_stop_code)) & + ,test_description_t("printing an integer stop code and delivering the non-zero exitstat", usher(exit_with_integer_stop_code)) & + ])) end function - function exit_with_no_stop_code() result(result_) - type(result_t) :: result_ + function exit_with_no_stop_code() result(diag) + type(test_diagnosis_t) :: diag integer exit_status integer command_status character(len=max_message_len) command_message @@ -32,21 +44,21 @@ function exit_with_no_stop_code() result(result_) command_message = "exit_with_no_stop_code" call execute_command_line( & - command = cmd_prefix//"./build/run-fpm.sh run --example error_stop_with_no_code > /dev/null 2>&1" & + command = cmd_prefix//fpm_driver//" run --example error_stop_with_no_code > /dev/null 2>&1" & ,wait = .true. & ,exitstat = exit_status & ,cmdstat = command_status & ,cmdmsg = command_message & ) - result_ = assert_that(exit_status /= 0, command_message) + diag = .expect. (exit_status /= 0) // command_message else - result_ = succeed("skipped") + diag = .true. end if end function - function exit_with_integer_stop_code() result(result_) - type(result_t) :: result_ + function exit_with_integer_stop_code() result(diag) + type(test_diagnosis_t) :: diag integer exit_status integer command_status character(len=max_message_len) command_message @@ -55,22 +67,21 @@ function exit_with_integer_stop_code() result(result_) command_message = "exit_with_integer_stop_code" call execute_command_line( & - command = cmd_prefix//"./build/run-fpm.sh run --example error_stop_with_integer_code > /dev/null 2>&1" & + command = cmd_prefix//fpm_driver//" run --example error_stop_with_integer_code > /dev/null 2>&1" & ,wait = .true. & ,exitstat = exit_status & ,cmdstat = command_status & ,cmdmsg = command_message & ) - result_ = & - assert_equals(expected_error_stop_code, exit_status, command_message) + diag = (exit_status .equalsExpected. expected_error_stop_code) // command_message else - result_ = succeed("skipped") + diag = .true. end if end function - function exit_with_character_stop_code() result(result_) - type(result_t) :: result_ + function exit_with_character_stop_code() result(diag) + type(test_diagnosis_t) :: diag integer exit_status integer command_status character(len=max_message_len) command_message @@ -79,17 +90,17 @@ function exit_with_character_stop_code() result(result_) command_message = "exit_with_character_stop_code" call execute_command_line( & - command = cmd_prefix//"./build/run-fpm.sh run --example error_stop_with_character_code > /dev/null 2>&1" & + command = cmd_prefix//fpm_driver//" run --example error_stop_with_character_code > /dev/null 2>&1" & ,wait = .true. & ,exitstat = exit_status & ,cmdstat = command_status & ,cmdmsg = command_message & ) - result_ = assert_that(exit_status /= 0, command_message) + diag = .expect. (exit_status /= 0) // command_message else - result_ = succeed("skipped") + diag = .true. end if end function -end module caf_error_stop_test +end module prif_error_stop_test_m diff --git a/test/prif_event_test.F90 b/test/prif_event_test.F90 index 0db533f8..e6c9b7f4 100644 --- a/test/prif_event_test.F90 +++ b/test/prif_event_test.F90 @@ -1,3 +1,4 @@ +#include "test-utils.F90" #include "assert_macros.h" ! TEST_ASSERT activates immediate assertions in test code @@ -8,7 +9,7 @@ #define call_assert_describe(c,d) #endif -module caf_event_test +module prif_event_test_m use assert_m use iso_c_binding, only: & c_ptr, c_int64_t, c_intptr_t, c_size_t, c_null_funptr, c_f_pointer, c_loc, c_sizeof @@ -28,21 +29,34 @@ module caf_event_test #else use prif, only : prif_deallocate_coarray, prif_deallocate_coarrays #endif - use veggies, only: result_t, test_item_t, assert_equals, describe, it, succeed + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, string_t, usher & + ,operator(.all.), operator(.also.), operator(.equalsExpected.), operator(//) implicit none private - public :: test_prif_event + public :: prif_event_test_t + + type, extends(test_t) :: prif_event_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type + contains - function test_prif_event() result(tests) - type(test_item_t) :: tests - - tests = describe( & - "PRIF Events", & - [ it("pass serial event test", check_event_serial) & - , it("pass parallel hot-spot event test", check_event_parallel) & - , it("pass parallel hot-spot notify test", check_notify) & - ]) + pure function subject() + character(len=:), allocatable :: subject + subject = "PRIF Events" + end function + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_event_test_t) prif_event_test + + allocate(test_results, source = prif_event_test%run([ & + test_description_t("a serial event test", usher(check_event_serial)) & + ,test_description_t("a parallel hot-spot event test", usher(check_event_parallel)) & + ,test_description_t("a parallel hot-spot notify test", usher(check_notify)) & + ])) end function function test_rand(lo, hi) result(result_) @@ -53,8 +67,8 @@ function test_rand(lo, hi) result(result_) call_assert(result_ >= lo .and. result_ <= hi) end function - function check_event_serial() result(result_) - type(result_t) :: result_ + function check_event_serial() result(diag) + type(test_diagnosis_t) diag integer :: me, num_imgs type(prif_event_type) :: dummy_event @@ -64,9 +78,9 @@ function check_event_serial() result(result_) type(prif_event_type), pointer :: local_event integer(c_intptr_t) :: base_addr + diag = .true. call RANDOM_INIT(REPEATABLE=.true., IMAGE_DISTINCT=.true.) - result_ = succeed("") sizeof_event = int(storage_size(dummy_event)/8, c_size_t) call prif_num_images(num_images=num_imgs) call prif_this_image_no_coarray(this_image=me) @@ -85,33 +99,33 @@ function check_event_serial() result(result_) block integer, parameter :: lim = 10 - integer i, j, expect, c, r - integer(c_int64_t) :: count + integer i, j, c, r + integer(c_int64_t) :: count, expect character(len=50) :: context expect = 0 do i=1, lim call prif_event_query(c_loc(local_event), count) - result_ = result_ .and. assert_equals(expect, int(count), "top of loop") - call_assert(expect == int(count)) + ALSO2(count .equalsExpected. expect, "event count at top of loop") + call_assert(expect == count) do j=1,i call prif_event_post(me, coarray_handle, 0_c_size_t) expect = expect + 1 call prif_event_query(c_loc(local_event), count) - result_ = result_ .and. assert_equals(expect, int(count), "after event_post") - call_assert(expect == int(count)) + ALSO2(count .equalsExpected. expect, "after event_post") + call_assert(expect == count) call prif_event_post_indirect(me, base_addr) expect = expect + 1 call prif_event_query(c_loc(local_event), count) - result_ = result_ .and. assert_equals(expect, int(count), "after event_post_indirect") - call_assert(expect == int(count)) + ALSO2(count .equalsExpected. expect, "event count after event_post_indirect") + call_assert(expect == count) if (expect >= 1) then - c = test_rand(1, expect) + c = test_rand(1, int(expect)) if (c > 1) then context = "after event_wait(c)" call prif_event_wait(c_loc(local_event), int(c,c_int64_t)) @@ -132,8 +146,8 @@ function check_event_serial() result(result_) expect = expect - c call prif_event_query(c_loc(local_event), count) - result_ = result_ .and. assert_equals(expect, int(count), context) - call_assert_describe(expect == int(count), context) + ALSO2(count .equalsExpected. expect, context) + call_assert_describe(expect == count, context) end if end do end do @@ -143,8 +157,8 @@ function check_event_serial() result(result_) end function - function check_event_parallel() result(result_) - type(result_t) :: result_ + function check_event_parallel() result(diag) + type(test_diagnosis_t) :: diag integer :: me, num_imgs type(prif_event_type) :: dummy_event @@ -155,7 +169,7 @@ function check_event_parallel() result(result_) type(prif_event_type), pointer :: local_evt integer, pointer :: local_ctr(:) - result_ = succeed("") + diag = .true. sizeof_event = int(storage_size(dummy_event)/8, c_size_t) sizeof_int = c_sizeof(me) call prif_num_images(num_images=num_imgs) @@ -210,9 +224,7 @@ function check_event_parallel() result(result_) call prif_event_wait(c_loc(local_evt), int(num_imgs,c_int64_t)) ! validate ctr(:)[1] == i - do j=1,num_imgs - result_ = result_ .and. assert_equals(i, local_ctr(j), "gather result") - end do + ALSO2(.all. (local_ctr(1:num_imgs) .equalsExpected. i), "gather result") ! image 1 writes back a coarray value to each image, then posts an event do j=1,num_imgs @@ -234,7 +246,7 @@ function check_event_parallel() result(result_) call prif_event_wait(c_loc(local_evt)) ! validate ctr(1)[me] == i - result_ = result_ .and. assert_equals(i, local_ctr(1), "scatter result") + ALSO2(local_ctr(1) .equalsExpected. i, "scatter result") end do end block @@ -242,8 +254,8 @@ function check_event_parallel() result(result_) call prif_deallocate_coarrays(([coarray_handle_ctr, coarray_handle_evt])) end function - function check_notify() result(result_) - type(result_t) :: result_ + function check_notify() result(diag) + type(test_diagnosis_t) diag integer :: me, num_imgs type(prif_notify_type) :: dummy_notify @@ -254,7 +266,7 @@ function check_notify() result(result_) type(prif_notify_type), pointer :: local_evt integer, pointer :: local_ctr(:) - result_ = succeed("") + diag = .true. sizeof_notify = int(storage_size(dummy_notify)/8, c_size_t) sizeof_int = c_sizeof(me) call prif_num_images(num_images=num_imgs) @@ -308,9 +320,7 @@ function check_notify() result(result_) call prif_notify_wait(c_loc(local_evt), int(num_imgs,c_int64_t)) ! validate ctr(:)[1] == i - do j=1,num_imgs - result_ = result_ .and. assert_equals(i, local_ctr(j), "gather result") - end do + ALSO2(.all. (local_ctr(1:num_imgs) .equalsExpected. i), "gather result") ! image 1 writes back a coarray value to each image with notify do j=1,num_imgs @@ -334,7 +344,7 @@ function check_notify() result(result_) call prif_notify_wait(c_loc(local_evt)) ! validate ctr(1)[me] == i - result_ = result_ .and. assert_equals(i, local_ctr(1), "scatter result") + ALSO2(local_ctr(1) .equalsExpected. i, "scatter result") end do end block @@ -342,4 +352,4 @@ function check_notify() result(result_) call prif_deallocate_coarrays(([coarray_handle_ctr, coarray_handle_evt])) end function -end module +end module prif_event_test_m diff --git a/test/prif_image_index_test.F90 b/test/prif_image_index_test.F90 index aa8abe46..8c9272a3 100644 --- a/test/prif_image_index_test.F90 +++ b/test/prif_image_index_test.F90 @@ -1,4 +1,6 @@ -module caf_image_index_test +#include "test-utils.F90" + +module prif_image_index_test_m use iso_c_binding, only: c_int, c_ptr, c_size_t, c_null_funptr, c_int64_t use prif, only: prif_coarray_handle, prif_allocate_coarray, & prif_image_index, prif_num_images, & @@ -17,39 +19,51 @@ module caf_image_index_test #else use prif, only : prif_deallocate_coarray, prif_deallocate_coarrays #endif - use veggies, only: result_t, test_item_t, assert_equals, assert_that, describe, it, succeed + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, string_t, usher & + ,operator(.also.), operator(.equalsExpected.), operator(.isAtLeast.), operator(.isAtMost.), operator(//) implicit none private - public :: test_prif_image_index + public :: prif_image_index_test_t + + type, extends(test_t) :: prif_image_index_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type contains - function test_prif_image_index() result(tests) - type(test_item_t) :: tests - - tests = describe( & - "prif_image_index and prif_initial_team_index", & - [ it("returns 1 for the simplest case", check_simple_case) & - , it("returns 1 when given the lower bounds", check_lower_bounds) & - , it("returns 0 with invalid subscripts", check_invalid_subscripts) & - , it("returns the expected answer for a more complicated case w/corank=2", check_complicated_2d) & - , it("returns the expected answer for a more complicated case w/corank=3", check_complicated_3d) & - , it("returns the expected answer with a child team and corank=2", check_complicated_2d_team) & - ]) + pure function subject() + character(len=:), allocatable :: subject + subject = "prif_image_index and prif_initial_team_index" + end function + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_image_index_test_t) prif_image_index_test + + allocate(test_results, source = prif_image_index_test%run([ & + test_description_t("returning 1 for the simplest case", usher(check_simple_case)) & + ,test_description_t("returning 1 when given the lower bounds", usher(check_lower_bounds)) & + ,test_description_t("returning 0 with invalid subscripts", usher(check_invalid_subscripts)) & + ,test_description_t("returning the expected answer for a more complicated case w/corank=2", usher(check_complicated_2d)) & + ,test_description_t("returning the expected answer for a more complicated case w/corank=3", usher(check_complicated_3d)) & + ,test_description_t("returning the expected answer with a child team and corank=2", usher(check_complicated_2d_team)) & + ])) end function - function check_this_image_coarray(coarray_handle, corank, team) result(result_) + function check_this_image_coarray(coarray_handle, corank, team) result(diag) type(prif_coarray_handle) :: coarray_handle integer(c_int) :: corank type(prif_team_type), optional :: team - type(result_t) :: result_ + type(test_diagnosis_t) :: diag integer(c_int64_t) :: co, cosubscripts(corank), colbound(corank), coubound(corank) integer(c_int) :: i, me, me_initial type(prif_team_type) :: initial_team - call prif_get_team(PRIF_INITIAL_TEAM, team=initial_team) + diag = .true. - result_ = succeed("") + call prif_get_team(PRIF_INITIAL_TEAM, team=initial_team) call prif_lcobound_no_dim(coarray_handle, colbound) call prif_ucobound_no_dim(coarray_handle, coubound) @@ -59,10 +73,10 @@ function check_this_image_coarray(coarray_handle, corank, team) result(result_) call prif_this_image_with_coarray(coarray_handle, team=team, cosubscripts=cosubscripts) do i=1,corank call prif_this_image_with_dim(coarray_handle, dim=i, team=team, cosubscript=co) - result_ = result_ .and. assert_equals(int(co), int(cosubscripts(i))) + ALSO(co .equalsExpected. cosubscripts(i)) - result_ = result_ .and. assert_that(co >= colbound(i)) - result_ = result_ .and. assert_that(co <= coubound(i)) + ALSO(co .isAtLeast. colbound(i)) + ALSO(co .isatMost. coubound(i)) end do ! verify reverse mapping @@ -71,7 +85,7 @@ function check_this_image_coarray(coarray_handle, corank, team) result(result_) else call prif_image_index(coarray_handle, cosubscripts, i) end if - result_ = result_ .and. assert_equals(i, me) + ALSO(i .equalsExpected. me) ! and prif_initial_team_index if (present(team)) then @@ -79,16 +93,19 @@ function check_this_image_coarray(coarray_handle, corank, team) result(result_) else call prif_initial_team_index(coarray_handle, cosubscripts, i) end if - result_ = result_ .and. assert_equals(i, me_initial) + ALSO(i .equalsExpected. me_initial) end function - function check_simple_case() result(result_) - type(result_t) :: result_ + function check_simple_case() result(diag) + type(test_diagnosis_t) :: diag type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory integer(c_int) :: answer, ni + + diag = .true. + call prif_num_images(num_images=ni) call prif_allocate_coarray( & @@ -99,23 +116,25 @@ function check_simple_case() result(result_) coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [1_c_int64_t], image_index=answer) - result_ = assert_equals(1_c_int, answer) + ALSO(answer .equalsExpected. 1_c_int ) call prif_initial_team_index(coarray_handle, [1_c_int64_t], initial_team_index=answer) - result_ = result_ .and. assert_equals(1_c_int, answer) + ALSO(answer .equalsExpected. 1_c_int) - result_ = result_ .and. & - check_this_image_coarray(coarray_handle, 1) + ALSO(check_this_image_coarray(coarray_handle, 1)) call prif_deallocate_coarray(coarray_handle) end function - function check_lower_bounds() result(result_) - type(result_t) :: result_ + function check_lower_bounds() result(diag) + type(test_diagnosis_t) :: diag type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory integer(c_int) :: answer, ni + + diag = .true. + call prif_num_images(num_images=ni) call prif_allocate_coarray( & @@ -126,23 +145,25 @@ function check_lower_bounds() result(result_) coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [2_c_int64_t, 3_c_int64_t], image_index=answer) - result_ = assert_equals(1_c_int, answer) + ALSO(answer .equalsExpected. 1_c_int) call prif_initial_team_index(coarray_handle, [2_c_int64_t, 3_c_int64_t], initial_team_index=answer) - result_ = result_ .and. assert_equals(1_c_int, answer) + ALSO(answer .equalsExpected. 1_c_int) - result_ = result_ .and. & - check_this_image_coarray(coarray_handle, 2) + ALSO(check_this_image_coarray(coarray_handle, 2)) call prif_deallocate_coarray(coarray_handle) end function - function check_invalid_subscripts() result(result_) - type(result_t) :: result_ + function check_invalid_subscripts() result(diag) + type(test_diagnosis_t) diag type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory integer(c_int) :: answer, ni + + diag = .true. + call prif_num_images(num_images=ni) call prif_allocate_coarray( & @@ -153,20 +174,22 @@ function check_invalid_subscripts() result(result_) coarray_handle = coarray_handle, & allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [-1_c_int64_t, 1_c_int64_t], image_index=answer) - result_ = assert_equals(0_c_int, answer) + ALSO(answer .equalsExpected. 0_c_int) - result_ = result_ .and. & - check_this_image_coarray(coarray_handle, 2) + ALSO(check_this_image_coarray(coarray_handle, 2)) call prif_deallocate_coarray(coarray_handle) end function - function check_complicated_2d() result(result_) - type(result_t) :: result_ + function check_complicated_2d() result(diag) + type(test_diagnosis_t) :: diag type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory integer(c_int) :: answer, ni, expected + + diag = .true. + call prif_num_images(num_images=ni) call prif_allocate_coarray( & @@ -178,26 +201,28 @@ function check_complicated_2d() result(result_) allocated_memory = allocated_memory) call prif_image_index(coarray_handle, [1_c_int64_t, 3_c_int64_t], image_index=answer) expected = merge(3_c_int,0_c_int,ni >= 3) - result_ = assert_equals(expected, answer) + ALSO(answer .equalsExpected. expected) if (expected > 0) then call prif_initial_team_index(coarray_handle, [1_c_int64_t, 3_c_int64_t], initial_team_index=answer) - result_ = result_ .and. assert_equals(expected, answer) + ALSO(answer .equalsExpected. expected) end if - result_ = result_ .and. & - check_this_image_coarray(coarray_handle, 2) + ALSO(check_this_image_coarray(coarray_handle, 2)) call prif_deallocate_coarray(coarray_handle) end function - function check_complicated_3d() result(result_) - type(result_t) :: result_ + function check_complicated_3d() result(diag) + type(test_diagnosis_t) diag type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory integer(c_int) :: answer, ni, expected type(prif_team_type) :: initial_team + + diag = .true. + call prif_get_team(team=initial_team) call prif_num_images_with_team(team=initial_team, num_images=ni) @@ -212,23 +237,22 @@ function check_complicated_3d() result(result_) [2_c_int64_t, 1_c_int64_t, 1_c_int64_t], & team=initial_team, image_index=answer) expected = merge(8_c_int,0_c_int,ni >= 8) - result_ = assert_equals(expected, answer) + ALSO(answer .equalsExpected. expected) if (expected > 0) then call prif_initial_team_index_with_team(coarray_handle, & [2_c_int64_t, 1_c_int64_t, 1_c_int64_t], & team=initial_team, initial_team_index=answer) - result_ = result_ .and. assert_equals(expected, answer) + ALSO(answer .equalsExpected. expected) endif - result_ = result_ .and. & - check_this_image_coarray(coarray_handle, 3) + ALSO(check_this_image_coarray(coarray_handle, 3)) call prif_deallocate_coarray(coarray_handle) end function - function check_complicated_2d_team() result(result_) - type(result_t) :: result_ + function check_complicated_2d_team() result(diag) + type(test_diagnosis_t) diag type(prif_coarray_handle) :: coarray_handle type(c_ptr) :: allocated_memory @@ -236,7 +260,7 @@ function check_complicated_2d_team() result(result_) integer(c_int64_t) :: which_team type(prif_team_type) :: initial_team, child_team - result_ = succeed("") + diag = .true. call prif_get_team(team=initial_team) call prif_num_images_with_team(team=initial_team, num_images=ni) @@ -261,140 +285,116 @@ function check_complicated_2d_team() result(result_) call prif_image_index_with_team(coarray_handle, & [0_c_int64_t, 2_c_int64_t], & team=initial_team, image_index=answer) - result_ = result_ .and. & - assert_equals(1_c_int, answer) + ALSO(answer .equalsExpected. 1_c_int) call prif_image_index_with_team_number(coarray_handle, & [0_c_int64_t, 2_c_int64_t], & team_number=-1_c_int64_t, image_index=answer) - result_ = result_ .and. & - assert_equals(1_c_int, answer) + ALSO(answer .equalsExpected. 1_c_int) call prif_image_index_with_team(coarray_handle, & [0_c_int64_t, 2_c_int64_t], & team=child_team, image_index=answer) - result_ = result_ .and. & - assert_equals(1_c_int, answer) + ALSO(answer .equalsExpected. 1_c_int) call prif_image_index_with_team_number(coarray_handle, & [0_c_int64_t, 2_c_int64_t], & team_number=which_team, image_index=answer) - result_ = result_ .and. & - assert_equals(1_c_int, answer) + ALSO(answer .equalsExpected. 1_c_int) call prif_image_index(coarray_handle, & [0_c_int64_t, 2_c_int64_t], & image_index=answer) - result_ = result_ .and. & - assert_equals(1_c_int, answer) + ALSO(answer .equalsExpected. 1_c_int) ! initial_team_index lcobound call prif_initial_team_index_with_team(coarray_handle, & [0_c_int64_t, 2_c_int64_t], & initial_team, answer) - result_ = result_ .and. & - assert_equals(1_c_int, answer) + ALSO(answer .equalsExpected. 1_c_int) call prif_initial_team_index_with_team_number(coarray_handle, & [0_c_int64_t, 2_c_int64_t], & -1_c_int64_t, answer) - result_ = result_ .and. & - assert_equals(1_c_int, answer) + ALSO(answer .equalsExpected. 1_c_int) call prif_initial_team_index_with_team(coarray_handle, & [0_c_int64_t, 2_c_int64_t], & child_team, answer) - result_ = result_ .and. & - assert_equals(merge(1_c_int,2_c_int,which_team==1), answer) + ALSO(answer .equalsExpected. merge(1_c_int,2_c_int,which_team==1)) call prif_initial_team_index_with_team_number(coarray_handle, & [0_c_int64_t, 2_c_int64_t], & which_team, answer) - result_ = result_ .and. & - assert_equals(merge(1_c_int,2_c_int,which_team==1), answer) + ALSO(answer .equalsExpected. merge(1_c_int,2_c_int,which_team==1)) call prif_initial_team_index(coarray_handle, & [0_c_int64_t, 2_c_int64_t], & answer) - result_ = result_ .and. & - assert_equals(merge(1_c_int,2_c_int,which_team==1), answer) + ALSO(answer .equalsExpected. merge(1_c_int,2_c_int,which_team==1)) ! image_index 3 call prif_image_index_with_team(coarray_handle, & [0_c_int64_t, 3_c_int64_t], & team=initial_team, image_index=answer) - result_ = result_ .and. & - assert_equals(merge(3_c_int,0_c_int,ni >= 3), answer) + ALSO(answer .equalsExpected. merge(3_c_int,0_c_int,ni >= 3)) call prif_image_index_with_team_number(coarray_handle, & [0_c_int64_t, 3_c_int64_t], & team_number=-1_c_int64_t, image_index=answer) - result_ = result_ .and. & - assert_equals(merge(3_c_int,0_c_int,ni >= 3), answer) + ALSO(answer .equalsExpected. merge(3_c_int,0_c_int,ni >= 3)) call prif_image_index_with_team(coarray_handle, & [0_c_int64_t, 3_c_int64_t], & team=child_team, image_index=answer) - result_ = result_ .and. & - assert_equals(merge(3_c_int,0_c_int,cni >= 3), answer) + ALSO(answer .equalsExpected. merge(3_c_int,0_c_int,cni >= 3)) call prif_image_index_with_team_number(coarray_handle, & [0_c_int64_t, 3_c_int64_t], & team_number=which_team, image_index=answer) - result_ = result_ .and. & - assert_equals(merge(3_c_int,0_c_int,cni >= 3), answer) + ALSO(answer .equalsExpected. merge(3_c_int,0_c_int,cni >= 3)) call prif_image_index(coarray_handle, & [0_c_int64_t, 3_c_int64_t], & image_index=answer) - result_ = result_ .and. & - assert_equals(merge(3_c_int,0_c_int,cni >= 3), answer) + ALSO(answer .equalsExpected. merge(3_c_int,0_c_int,cni >= 3)) ! initial_team_index 3 if (ni >= 3) then call prif_initial_team_index_with_team(coarray_handle, & [0_c_int64_t, 3_c_int64_t], & team=initial_team, initial_team_index=answer) - result_ = result_ .and. & - assert_equals(3_c_int, answer) + ALSO(answer .equalsExpected. 3_c_int) call prif_initial_team_index_with_team_number(coarray_handle, & [0_c_int64_t, 3_c_int64_t], & team_number=-1_c_int64_t, initial_team_index=answer) - result_ = result_ .and. & - assert_equals(3_c_int, answer) + ALSO(answer .equalsExpected. 3_c_int) end if if (cni >= 3) then call prif_initial_team_index_with_team(coarray_handle, & [0_c_int64_t, 3_c_int64_t], & team=child_team, initial_team_index=answer) - result_ = result_ .and. & - assert_equals(merge(5_c_int,6_c_int,which_team==1), answer) + ALSO(answer .equalsExpected. merge(5_c_int,6_c_int,which_team==1)) call prif_initial_team_index_with_team_number(coarray_handle, & [0_c_int64_t, 3_c_int64_t], & team_number=which_team, initial_team_index=answer) - result_ = result_ .and. & - assert_equals(merge(5_c_int,6_c_int,which_team==1), answer) + ALSO(answer .equalsExpected. merge(5_c_int,6_c_int,which_team==1)) call prif_initial_team_index(coarray_handle, & [0_c_int64_t, 3_c_int64_t], & initial_team_index=answer) - result_ = result_ .and. & - assert_equals(merge(5_c_int,6_c_int,which_team==1), answer) + ALSO(answer .equalsExpected. merge(5_c_int,6_c_int,which_team==1)) end if - result_ = result_ .and. & - check_this_image_coarray(coarray_handle, 2, initial_team) - result_ = result_ .and. & - check_this_image_coarray(coarray_handle, 2, child_team) + ALSO(check_this_image_coarray(coarray_handle, 2, initial_team)) + ALSO(check_this_image_coarray(coarray_handle, 2, child_team)) call prif_end_team() call prif_deallocate_coarray(coarray_handle) end function - - end module diff --git a/test/prif_image_queries_test.F90 b/test/prif_image_queries_test.F90 index 5a135107..6f533cbc 100644 --- a/test/prif_image_queries_test.F90 +++ b/test/prif_image_queries_test.F90 @@ -30,18 +30,18 @@ module prif_image_queries_test_m pure function subject() result(test_subject) character(len=:), allocatable :: test_subject - test_subject = "PRIF image query procedures" + test_subject = "PRIF Image Queries" 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([ & + allocate(test_results, source = 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) @@ -61,7 +61,7 @@ function valid_image_list(nums) result(diag) call prif_num_images(num_images=ni) diag = & - .expect. allocated(nums) .also. & + allocated(nums) .also. & (size(nums) .isAtMost. ni) .also. & (.all. (nums .isAtLeast. 1)) .also. & (.all. (nums .isAtMost. ni)) .also. & diff --git a/test/prif_init_test.F90 b/test/prif_init_test.F90 index dcb0931d..27ab9af2 100644 --- a/test/prif_init_test.F90 +++ b/test/prif_init_test.F90 @@ -4,7 +4,7 @@ module prif_init_test_m implicit none private - public :: prif_init_test_t + public :: prif_init_test_t, check_caffeination type, extends(test_t) :: prif_init_test_t contains @@ -23,24 +23,35 @@ 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([ & + allocate(test_results, source = 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) + ! 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. + 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 + integer init_exit_code + + call prif_init(init_exit_code) + memo = init_exit_code .equalsExpected. successful_initiation + end block + endif - call prif_init(init_exit_code) - diag = init_exit_code .equalsExpected. successful_initiation + diag = memo end function function check_subsequent_prif_init_call() result(diag) diff --git a/test/prif_num_images_test.F90 b/test/prif_num_images_test.F90 index c817446b..e17d0ba5 100644 --- a/test/prif_num_images_test.F90 +++ b/test/prif_num_images_test.F90 @@ -30,9 +30,9 @@ 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([ & + allocate(test_results, source = 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 diff --git a/test/prif_rma_test.F90 b/test/prif_rma_test.F90 index ff13b8bb..e4de8bcd 100644 --- a/test/prif_rma_test.F90 +++ b/test/prif_rma_test.F90 @@ -1,4 +1,4 @@ -module caf_rma_test +module prif_rma_test_m use iso_c_binding, only: & c_ptr, c_int64_t, c_intptr_t, c_size_t, c_null_funptr, c_f_pointer, c_loc, c_sizeof use prif, only: & @@ -21,26 +21,39 @@ module caf_rma_test #else use prif, only : prif_deallocate_coarray, prif_deallocate_coarrays #endif - use veggies, only: result_t, test_item_t, assert_equals, describe, it + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, usher, operator(.equalsExpected.) implicit none private - public :: test_prif_rma + public :: prif_rma_test_t + + type, extends(test_t) :: prif_rma_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type + contains - function test_prif_rma() result(tests) - type(test_item_t) :: tests - - tests = describe( & - "PRIF RMA", & - [ it("can send a value to another image", check_put) & - , it("can send a value with indirect interface", check_put_indirect) & - , it("can get a value from another image", check_get) & - , it("can get a value with indirect interface", check_get_indirect) & - ]) + + pure function subject() + character(len=:), allocatable :: subject + subject = "PRIF RMA" + end function + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_rma_test_t) prif_rma_test + + allocate(test_results, source = prif_rma_test%run([ & + test_description_t("sending a value to another image", usher(check_put)) & + ,test_description_t("sending a value with indirect interface", usher(check_put_indirect)) & + ,test_description_t("getting a value from another image", usher(check_get)) & + ,test_description_t("getting a value with indirect interface", usher(check_get_indirect)) & + ])) end function - function check_put() result(result_) - type(result_t) :: result_ + function check_put() result(diag) + type(test_diagnosis_t) :: diag integer :: dummy_element, num_imgs, expected, neighbor integer, target :: me @@ -76,13 +89,13 @@ function check_put() result(result_) ! superfluous, just to ensure prif_sync_memory is usable call prif_sync_memory - result_ = assert_equals(expected, local_slice) + diag = local_slice .equalsExpected. expected call prif_deallocate_coarray(coarray_handle) end function - function check_put_indirect() result(result_) - type(result_t) :: result_ + function check_put_indirect() result(diag) + type(test_diagnosis_t) :: diag type :: my_type type(c_ptr) :: my_component @@ -133,14 +146,14 @@ function check_put_indirect() result(result_) call prif_sync_all call c_f_pointer(local_slice%my_component, component_access) - result_ = assert_equals(expected, component_access) + diag = component_access .equalsExpected. expected call prif_deallocate(local_slice%my_component) call prif_deallocate_coarray(coarray_handle) end function - function check_get() result(result_) - type(result_t) :: result_ + function check_get() result(diag) + type(test_diagnosis_t) :: diag integer :: dummy_element, num_imgs, me, neighbor, expected integer, target :: retrieved @@ -174,13 +187,13 @@ function check_get() result(result_) current_image_buffer = c_loc(retrieved), & size_in_bytes = c_sizeof(retrieved)) - result_ = assert_equals(expected, retrieved) + diag = retrieved .equalsExpected. expected call prif_deallocate_coarray(coarray_handle) end function - function check_get_indirect() result(result_) - type(result_t) :: result_ + function check_get_indirect() result(diag) + type(test_diagnosis_t) :: diag type :: my_type type(c_ptr) :: my_component @@ -231,7 +244,7 @@ function check_get_indirect() result(result_) current_image_buffer = c_loc(retrieved), & size_in_bytes = int(storage_size(retrieved)/8, c_size_t)) - result_ = assert_equals(expected, retrieved) + diag = retrieved .equalsExpected. expected call prif_deallocate(local_slice%my_component) call prif_deallocate_coarray(coarray_handle) diff --git a/test/prif_stop_test.F90 b/test/prif_stop_test.F90 index 9f0b345d..e142d1c9 100644 --- a/test/prif_stop_test.F90 +++ b/test/prif_stop_test.F90 @@ -1,30 +1,42 @@ -module caf_stop_test +module prif_stop_test_m use prif, only: prif_this_image_no_coarray, prif_sync_all - use veggies, only: test_item_t, describe, result_t, it, assert_that, assert_equals, succeed + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, usher & + ,operator(.equalsExpected.), operator(//) use unit_test_parameters_m, only : expected_stop_code, & - image_one => subjob_setup, cmd_prefix => subjob_prefix + image_one => subjob_setup, cmd_prefix => subjob_prefix, fpm_driver implicit none private - public :: test_prif_stop + public :: prif_stop_test_t + + type, extends(test_t) :: prif_stop_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type integer, parameter :: max_message_len = 128 contains - function test_prif_stop() result(tests) - type(test_item_t) :: tests - - tests = describe( & - "A program that executes the prif_stop function", & - [ it("exits with a zero exitstat when the program omits the stop code", exit_with_no_stop_code) & - ,it("prints an integer stop code and exits with exitstat equal to the stop code", exit_with_integer_stop_code) & - ,it("prints a character stop code and exits with a non-zero exitstat", exit_with_character_stop_code) & - ,it("invokes a registered callback", check_callback_invocation) & - ]) + pure function subject() + character(len=:), allocatable :: subject + subject = "prif_stop" + end function + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_stop_test_t) prif_stop_test + + allocate(test_results, source = prif_stop_test%run([ & + test_description_t("delivering a zero exitstat when the stop code is omitted", usher(exit_with_no_stop_code)) & + ,test_description_t("printing an integer stop code and delivering the non-zero exitstat", usher(exit_with_integer_stop_code)) & + ,test_description_t("printing a character stop code and delivering a zero exitstat", usher(exit_with_character_stop_code)) & + ,test_description_t("invoking a registered callback", usher(check_callback_invocation)) & + ])) end function - function exit_with_no_stop_code() result(result_) - type(result_t) :: result_ + function exit_with_no_stop_code() result(diag) + type(test_diagnosis_t) :: diag integer exit_status, cmd_stat character(len=max_message_len) command_message @@ -32,21 +44,21 @@ function exit_with_no_stop_code() result(result_) command_message = "exit_with_no_stop_code" call execute_command_line( & - command = cmd_prefix//"./build/run-fpm.sh run --example stop_with_no_code > /dev/null 2>&1", & + command = cmd_prefix//fpm_driver//" run --example stop_with_no_code > /dev/null 2>&1", & wait = .true., & exitstat = exit_status, & cmdstat = cmd_stat, & cmdmsg = command_message & ) - result_ = assert_equals(0, exit_status, command_message) + diag = (exit_status .equalsExpected. 0) // command_message else - result_ = succeed("skipped") + diag = .true. end if end function - function exit_with_integer_stop_code() result(result_) - type(result_t) :: result_ + function exit_with_integer_stop_code() result(diag) + type(test_diagnosis_t) :: diag integer exit_status, cmd_stat character(len=max_message_len) command_message @@ -54,21 +66,21 @@ function exit_with_integer_stop_code() result(result_) command_message = "exit_with_integer_stop_code" call execute_command_line( & - command = cmd_prefix//"./build/run-fpm.sh run --example stop_with_integer_code > /dev/null 2>&1", & + command = cmd_prefix//fpm_driver//" run --example stop_with_integer_code > /dev/null 2>&1", & wait = .true., & exitstat = exit_status, & cmdstat = cmd_stat, & cmdmsg = command_message & ) - result_ = assert_equals(expected_stop_code, exit_status, command_message) + diag = (exit_status .equalsExpected. expected_stop_code) // command_message else - result_ = succeed("skipped") + diag = .true. end if end function - function exit_with_character_stop_code() result(result_) - type(result_t) :: result_ + function exit_with_character_stop_code() result(diag) + type(test_diagnosis_t) :: diag integer exit_status, cmd_stat character(len=max_message_len) command_message @@ -76,37 +88,37 @@ function exit_with_character_stop_code() result(result_) command_message = "exit_with_character_stop_code" call execute_command_line( & - command = cmd_prefix//"./build/run-fpm.sh run --example stop_with_character_code > /dev/null 2>&1", & + command = cmd_prefix//fpm_driver//" run --example stop_with_character_code > /dev/null 2>&1", & wait = .true., & exitstat = exit_status, & cmdstat = cmd_stat, & cmdmsg = command_message & ) ! the standard recommends zero exit status for character stop codes - result_ = assert_equals(0, exit_status, command_message) + diag = (exit_status .equalsExpected. 0) // command_message else - result_ = succeed("skipped") + diag = .true. end if end function - function check_callback_invocation() result(result_) - type(result_t) :: result_ + function check_callback_invocation() result(diag) + type(test_diagnosis_t) :: diag integer exit_status, cmd_stat character(len=max_message_len) command_message if (image_one()) then call execute_command_line( & - command = cmd_prefix//"./build/run-fpm.sh run --example register_stop_callback > /dev/null 2>&1", & + command = cmd_prefix//fpm_driver//" run --example register_stop_callback > /dev/null 2>&1", & wait = .true., & exitstat = exit_status, & cmdstat = cmd_stat, & cmdmsg = command_message & ) - result_ = assert_equals(0, exit_status, command_message) + diag = (exit_status .equalsExpected. 0) // command_message else - result_ = succeed("skipped") + diag = .true. end if end function -end module caf_stop_test +end module prif_stop_test_m diff --git a/test/prif_strided_test.F90 b/test/prif_strided_test.F90 index a86d6e7c..ab39e439 100644 --- a/test/prif_strided_test.F90 +++ b/test/prif_strided_test.F90 @@ -1,4 +1,4 @@ -module caf_strided_test +module prif_strided_test_m use iso_c_binding, only: & c_ptr, c_int64_t, c_intptr_t, c_size_t, c_null_funptr, c_f_pointer, c_loc, c_sizeof use prif, only: & @@ -21,52 +21,40 @@ module caf_strided_test #else use prif, only : prif_deallocate_coarray, prif_deallocate_coarrays #endif - use veggies, only: result_t, test_item_t, assert_equals, describe, it, succeed, fail - + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, usher & + ,operator(.all.), operator(.equalsExpected.) + implicit none private - public :: test_prif_rma_strided + public :: prif_strided_test_t + + type, extends(test_t) :: prif_strided_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type + contains - function test_prif_rma_strided() result(tests) - type(test_item_t) :: tests - - tests = describe( & - "PRIF Strided RMA", & - [ it("can put strided data to another image", check_put) & - , it("can put strided data with indirect interface", check_put_indirect) & - , it("can get strided data from another image", check_get) & - , it("can get strided data with indirect interface", check_get_indirect) & - ]) + + pure function subject() + character(len=:), allocatable :: subject + subject = "PRIF Strided RMA" end function - function assert_equals_array2d(expected, actual) result(result_) - integer, intent(in) :: expected(:,:) - integer, intent(in) :: actual(:,:) - type(result_t) :: result_ - integer :: i,j - - result_ = succeed("") - result_ = result_ .and. assert_equals(size(expected,1), size(actual,1)) - result_ = result_ .and. assert_equals(size(expected,2), size(actual,2)) - - do i = lbound(actual,1), ubound(actual,1) - do j = lbound(actual,2), ubound(actual,2) - block - character(len=100) :: result_string - - write(result_string, '("At position (", I0, ",", I0, ") expected=", I0, " actual=", I0)') & - i, j, expected(i,j), actual(i,j) - - result_ = result_ .and. & - assert_equals(expected(i,j), actual(i,j), result_string) - end block - end do - end do - + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_strided_test_t) prif_strided_test + + allocate(test_results, source = prif_strided_test%run([ & + test_description_t("putting strided data to another image", usher(check_put)) & + ,test_description_t("putting strided data with indirect interface", usher(check_put_indirect)) & + ,test_description_t("getting strided data from another image", usher(check_get)) & + ,test_description_t("getting strided data with indirect interface", usher(check_get_indirect)) & + ])) end function - function check_put() result(result_) - type(result_t) :: result_ + function check_put() result(diag) + type(test_diagnosis_t) :: diag integer :: me, num_imgs, neighbor type(prif_coarray_handle) :: coarray_handle @@ -116,13 +104,13 @@ function check_put() result(result_) call prif_sync_all - result_ = assert_equals_array2d(expected, local_slice) + diag = .all. (local_slice .equalsExpected. expected) call prif_deallocate_coarray(coarray_handle) end function - function check_put_indirect() result(result_) - type(result_t) :: result_ + function check_put_indirect() result(diag) + type(test_diagnosis_t) :: diag type :: my_type type(c_ptr) :: my_component @@ -190,14 +178,14 @@ function check_put_indirect() result(result_) call prif_sync_all - result_ = assert_equals_array2d(expected, component_access) + diag = .all. (component_access .equalsExpected. expected) call prif_deallocate(local_slice%my_component) call prif_deallocate_coarray(coarray_handle) end function - function check_get() result(result_) - type(result_t) :: result_ + function check_get() result(diag) + type(test_diagnosis_t) :: diag integer :: me, num_imgs, neighbor type(prif_coarray_handle) :: coarray_handle @@ -245,13 +233,13 @@ function check_get() result(result_) call prif_sync_all - result_ = assert_equals_array2d(expected, mydata) + diag = .all. (mydata .equalsExpected. expected) call prif_deallocate_coarray(coarray_handle) end function - function check_get_indirect() result(result_) - type(result_t) :: result_ + function check_get_indirect() result(diag) + type(test_diagnosis_t) :: diag type :: my_type type(c_ptr) :: my_component @@ -317,7 +305,7 @@ function check_get_indirect() result(result_) call prif_sync_all - result_ = assert_equals_array2d(expected, mydata) + diag = .all. (mydata .equalsExpected. expected) call prif_deallocate(local_slice%my_component) call prif_deallocate_coarray(coarray_handle) diff --git a/test/prif_sync_images_test.F90 b/test/prif_sync_images_test.F90 index 710f4115..6ba68386 100644 --- a/test/prif_sync_images_test.F90 +++ b/test/prif_sync_images_test.F90 @@ -1,7 +1,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.), usher + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, usher implicit none private @@ -26,11 +26,11 @@ 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([ & + allocate(test_results, source = 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(diag) diff --git a/test/prif_teams_test.F90 b/test/prif_teams_test.F90 index d8feb0f7..dddb5ca2 100644 --- a/test/prif_teams_test.F90 +++ b/test/prif_teams_test.F90 @@ -1,4 +1,6 @@ -module caf_teams_test +#include "test-utils.F90" + +module prif_teams_test_m use iso_c_binding, only: c_size_t, c_ptr, c_null_funptr, c_int64_t, c_int use prif #if FORCE_PRIF_0_5 || FORCE_PRIF_0_6 @@ -6,23 +8,36 @@ module caf_teams_test # define prif_deallocate_coarray(h) prif_deallocate_coarray_([h]) # define prif_deallocate_coarrays(arr) prif_deallocate_coarray_(arr) #endif - use veggies, only: result_t, test_item_t, assert_equals, assert_that, describe, it, succeed, fail + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, string_t, usher & + ,operator(.also.), operator(.isAtLeast.), operator(.isAtMost.), operator(.equalsExpected.), operator(//) implicit none private - public :: test_caf_teams + public :: prif_teams_test_t + + type, extends(test_t) :: prif_teams_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type + contains - function test_caf_teams() result(tests) - type(test_item_t) :: tests + pure function subject() + character(len=:), allocatable :: subject + subject = "PRIF Teams" + end function + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_teams_test_t) prif_teams_test - tests = describe( & - "Teams", & - [ it("can be created, changed to, and allocate coarrays", check_teams) & - ]) + allocate(test_results, source = prif_teams_test%run([ & + test_description_t("creating, changing to, and allocating coarrays", usher(check_teams)) & + ])) end function - function check_teams() result(result_) - type(result_t) :: result_ + function check_teams() result(diag) + type(test_diagnosis_t) :: diag ! TODO: use final_func to observe automatic deallocation of coarrays integer :: dummy_element, i @@ -34,73 +49,60 @@ function check_teams() result(result_) type(c_ptr) :: allocated_memory type(prif_team_type) :: team, initial_team, t - result_ = succeed("") + diag = .true. call prif_num_images(num_images=initial_num_imgs) - result_ = result_ .and. & - assert_that(initial_num_imgs > 0, "prif_num_images is valid") + ALSO2(initial_num_imgs .isAtLeast. 1, "invalid prif_num_images") call prif_this_image_no_coarray(this_image=me) - result_ = result_ .and. & - assert_that(me >= 1 .and. me <= initial_num_imgs, "prif_this_image is valid") + ALSO2(me .isAtLeast. 1, "invalid prif_this_image") + ALSO2(me .isAtMost. initial_num_imgs, "invalid prif_this_image") n = 0 ! clear outputs call prif_team_number(team_number=n) - result_ = result_ .and. & - assert_equals(int(n), -1, "Initial team number is -1") + ALSO2(n .equalsExpected. -1_c_int64_t, "Initial team number is -1") n = 0 ! clear outputs call prif_get_team(team=initial_team) call prif_team_number(team=initial_team, team_number=n) - result_ = result_ .and. & - assert_equals(int(n), -1, "prif_get_team retrieves current initial team") - + ALSO2(n .equalsExpected. -1_c_int64_t, "prif_get_team retrieval of current initial team") + ! ensure prif_sync_team is usable call prif_sync_team(team=initial_team) x = 0 ! clear outputs call prif_num_images_with_team(team=initial_team, num_images=x) - result_ = result_ .and. & - assert_equals(x, initial_num_imgs, "prif_num_images works with initial team") - + ALSO2(x .equalsExpected. initial_num_imgs, "prif_num_images in initial team") + x = 0 ! clear outputs call prif_num_images_with_team_number(team_number=-1_c_int64_t, num_images=x) - result_ = result_ .and. & - assert_equals(x, initial_num_imgs, "prif_num_images_with_team_number works with initial team") + ALSO2(x .equalsExpected. initial_num_imgs, "prif_num_images_with_team_number in initial team") x = 0 ! clear outputs call prif_this_image_no_coarray(team=initial_team, this_image=x) - result_ = result_ .and. & - assert_equals(x, me, "prif_this_image_no_coarray works with initial team") - + ALSO2(x .equalsExpected. me, "prif_this_image_no_coarray in initial team") + t = prif_team_type() ; n = 0 ! clear outputs call prif_get_team(level=PRIF_INITIAL_TEAM, team=t) call prif_team_number(team=t, team_number=n) - result_ = result_ .and. & - assert_equals(int(n), -1, "prif_get_team(PRIF_INITIAL_TEAM) retrieves initial team") - + ALSO2(n .equalsExpected. -1_c_int64_t, "prif_get_team(PRIF_INITIAL_TEAM) retrieves initial team") + t = prif_team_type() ; n = 0 ! clear outputs call prif_get_team(level=PRIF_CURRENT_TEAM, team=t) call prif_team_number(team=t, team_number=n) - result_ = result_ .and. & - assert_equals(int(n), -1, "prif_get_team(PRIF_CURRENT_TEAM) retrieves initial team when current team is initial team") + ALSO2(n .equalsExpected. -1_c_int64_t, "prif_get_team(PRIF_CURRENT_TEAM) retrieval of initial team when current team is initial team") t = prif_team_type() ; n = 0 ! clear outputs call prif_get_team(level=PRIF_PARENT_TEAM, team=t) call prif_team_number(team=t, team_number=n) - result_ = result_ .and. & - assert_equals(int(n), -1, "prif_get_team(PRIF_PARENT_TEAM) retrieves initial team when parent team is initial team") - + ALSO2(n .equalsExpected. -1_c_int64_t, "prif_get_team(PRIF_PARENT_TEAM) retrieves initial team when parent team is initial team") + which_team = merge(1_c_int64_t, 2_c_int64_t, mod(me, 2) == 0) element_size = int(storage_size(dummy_element)/8, c_size_t) call prif_form_team(team_number = which_team, team = team) call prif_change_team(team) call prif_num_images(num_images=num_imgs) - result_ = result_ .and. & - assert_equals( & - initial_num_imgs/2 + mod(initial_num_imgs,2)*(int(which_team)-1), & - num_imgs, & - "Team has correct number of images") + ALSO2(num_imgs .equalsExpected. initial_num_imgs/2 + mod(initial_num_imgs,2)*(int(which_team)-1), "Team has correct number of images") ! ensure prif_sync_team is usable call prif_sync_team(team=team) @@ -108,72 +110,59 @@ function check_teams() result(result_) x = 0 ! clear outputs call prif_num_images_with_team(team=team, num_images=x) - result_ = result_ .and. & - assert_equals(x, num_imgs, "prif_num_images works with team") + ALSO2(x .equalsExpected. num_imgs, "prif_num_images works with team") x = 0 ! clear outputs call prif_num_images_with_team_number(team_number=which_team, num_images=x) - result_ = result_ .and. & - assert_equals(x, num_imgs, "prif_num_images_with_team_number works with current team") + ALSO2 (x .equalsExpected. num_imgs, "prif_num_images_with_team_number works with current team") call prif_this_image_no_coarray(this_image=me_child) - result_ = result_ .and. & - assert_equals(me_child, (me - 1)/2 + 1, "prif_this_image is valid") + ALSO2(me_child .equalsExpected. (me - 1)/2 + 1, "prif_this_image is valid") + x = 0 ! clear outputs call prif_this_image_no_coarray(team=team, this_image=x) - result_ = result_ .and. & - assert_equals(x, me_child, "prif_this_image is valid") + ALSO2(x .equalsExpected. me_child, "prif_this_image is valid") n = 0 ! clear outputs call prif_team_number(team_number=n) - result_ = result_ .and. & - assert_equals(int(n), int(which_team), "Correct current team number") + ALSO2(n .equalsExpected. which_team, "Correct current team number") n = 0 ! clear outputs call prif_team_number(team=team, team_number=n) - result_ = result_ .and. & - assert_equals(int(n), int(which_team), "Correct current team number") + ALSO2(n .equalsExpected. which_team, "Correct current team number") t = prif_team_type() ; n = 0 ! clear outputs call prif_get_team(team=t) call prif_team_number(team=t, team_number=n) - result_ = result_ .and. & - assert_equals(int(n), int(which_team), "prif_get_team retrieves current team") + ALSO2(n .equalsExpected. which_team, "prif_get_team retrieves current team") t = prif_team_type() ; n = 0 ! clear outputs call prif_get_team(level=PRIF_INITIAL_TEAM, team=t) call prif_team_number(team=t, team_number=n) - result_ = result_ .and. & - assert_equals(int(n), -1, "prif_get_team(PRIF_INITIAL_TEAM) retrieves initial team") + ALSO2(n .equalsExpected. -1_c_int64_t, "prif_get_team(PRIF_INITIAL_TEAM) retrieves initial team") t = prif_team_type() ; n = 0 ! clear outputs call prif_get_team(level=PRIF_CURRENT_TEAM, team=t) call prif_team_number(team=t, team_number=n) - result_ = result_ .and. & - assert_equals(int(n), int(which_team), "prif_get_team(PRIF_CURRENT_TEAM) retrieves current team") + ALSO2(n .equalsExpected. which_team, "prif_get_team(PRIF_CURRENT_TEAM) retrieves current team") t = prif_team_type() ; n = 0 ! clear outputs call prif_get_team(level=PRIF_PARENT_TEAM, team=t) call prif_team_number(team=t, team_number=n) - result_ = result_ .and. & - assert_equals(int(n), -1, "prif_get_team(PRIF_PARENT_TEAM) retrieves initial team when parent team is initial team") + ALSO2(n .equalsExpected. -1_c_int64_t, "prif_get_team(PRIF_PARENT_TEAM) retrieves initial team when parent team is initial team") x = 0 ! clear outputs call prif_num_images_with_team(team=initial_team, num_images=x) - result_ = result_ .and. & - assert_equals(x, initial_num_imgs, "prif_num_images works with initial team") + ALSO2(x .equalsExpected. initial_num_imgs, "prif_num_images works with initial team") x = 0 ! clear outputs call prif_num_images_with_team_number(team_number=-1_c_int64_t, num_images=x) - result_ = result_ .and. & - assert_equals(x, initial_num_imgs, "prif_num_images_with_team_number works with initial team") + ALSO2(x .equalsExpected. initial_num_imgs, "prif_num_images_with_team_number works with initial team") x = 0 ! clear outputs call prif_this_image_no_coarray(team=initial_team, this_image=x) - result_ = result_ .and. & - assert_equals(x, me, "prif_this_image_no_coarray works with initial team") - + ALSO2(x .equalsExpected. me, "prif_this_image_no_coarray works with initial team") do i = 1, num_coarrays call prif_allocate_coarray( & @@ -196,9 +185,7 @@ function check_teams() result(result_) t = prif_team_type() ; n = 0 ! clear outputs call prif_get_team(team=t) call prif_team_number(team=t, team_number=n) - result_ = result_ .and. & - assert_equals(int(n), -1, "prif_end_team restores initial team") + ALSO2(n .equalsExpected. -1_c_int64_t, "prif_end_team restores initial team") - result_ = result_.and.succeed("Seems to have worked") end function -end module +end module prif_teams_test_m diff --git a/test/prif_this_image_test.F90 b/test/prif_this_image_test.F90 index 5aa071d1..d0efe599 100644 --- a/test/prif_this_image_test.F90 +++ b/test/prif_this_image_test.F90 @@ -30,9 +30,9 @@ 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([ & + allocate(test_results, source = 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) @@ -42,7 +42,7 @@ function check_this_image_set() result(diag) 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)] + allocate(image_numbers, source = [(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 diff --git a/test/prif_types_test.F90 b/test/prif_types_test.F90 index 7e2722da..3e563e4d 100644 --- a/test/prif_types_test.F90 +++ b/test/prif_types_test.F90 @@ -1,11 +1,21 @@ -module prif_types_test +#include "test-utils.F90" + +module prif_types_test_m use iso_fortran_env, only: int8 - use prif - use veggies, only: result_t, test_item_t, assert_that, assert_not, assert_equals, describe, it, succeed + use prif, only: prif_team_type, prif_event_type, prif_notify_type, prif_lock_type, prif_critical_type + use julienne_m, only: test_description_t, test_diagnosis_t, test_result_t, test_t, string_t, usher & + ,operator(.all.), operator(.also.), operator(.equalsExpected.), operator(.greaterThan.), operator(.isAtMost.), operator(//) implicit none private - public :: test_prif_types + public :: prif_types_test_t + + + type, extends(test_t) :: prif_types_test_t + contains + procedure, nopass, non_overridable :: subject + procedure, nopass, non_overridable :: results + end type type, private :: dummy_t private @@ -19,120 +29,115 @@ module prif_types_test end type contains - function test_prif_types() result(tests) - type(test_item_t) :: tests - - tests = describe( & - "PRIF types", & - [ it("prif_team_type has a compliant representation", check_team_type) & - , it("prif_event_type has a compliant representation", check_event_type) & - , it("prif_lock_type has a compliant representation", check_lock_type) & - , it("prif_notify_type has a compliant representation", check_notify_type) & - , it("prif_critical_type has a compliant representation", check_critical_type) & - ]) + pure function subject() + character(len=:), allocatable :: subject + subject = "PRIF Types" + end function + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(prif_types_test_t) prif_types_test + + allocate(test_results, source = prif_types_test%run([ & + test_description_t("having a compliant prif_team_type representation", usher(check_team_type)) & + , test_description_t("having a compliant prif_event_type representation", usher(check_event_type)) & + , test_description_t("having a compliant prif_lock_type representation", usher(check_lock_type)) & + , test_description_t("having a compliant prif_notify_type representation", usher(check_notify_type)) & + , test_description_t("having a compliant prif_critical_type representation", usher(check_critical_type)) & + ])) end function function check_team_type() result(diag) - type(result_t) :: diag + type(test_diagnosis_t) :: diag type(prif_team_type) :: team type(pointer_wrapper_t) :: pointer_wrap type(dummy_t), target :: tgt - diag = succeed("") + diag = .true. ! size check - diag = diag .and. & - assert_equals(storage_size(team), storage_size(pointer_wrap)) + ALSO(storage_size(team) .equalsExpected. storage_size(pointer_wrap)) ! default initialization check pointer_wrap%info => tgt pointer_wrap = transfer(team, pointer_wrap) - diag = diag .and. & - assert_that(.not. associated(pointer_wrap%info)) + ALSO2(.not. associated(pointer_wrap%info), "default initialization to null") end function function check_event_type() result(diag) - type(result_t) :: diag + type(test_diagnosis_t) :: diag type(prif_event_type) :: event integer :: ssz integer(int8), allocatable :: bytes(:) - diag = succeed("") + diag = .true. ! size check ssz = storage_size(event) - diag = diag .and. & - assert_that(ssz > 0) .and. & - assert_that(ssz <= 64*8) + ALSO(ssz .greaterThan. 0) + ALSO(ssz .isAtMost. 64*8) ! default initialization check allocate(bytes(64)) bytes = transfer(event, bytes) - diag = diag .and. & - assert_that( all(bytes == 0) ) + ALSO2(.all.(int(bytes) .equalsExpected. 0), "default initialization to zero") end function function check_lock_type() result(diag) - type(result_t) :: diag + type(test_diagnosis_t) :: diag type(prif_lock_type) :: lock integer :: ssz integer(int8), allocatable :: bytes(:) - diag = succeed("") + diag = .true. ! size check ssz = storage_size(lock) - diag = diag .and. & - assert_that(ssz > 0) .and. & - assert_that(ssz <= 64*8) + ALSO(ssz .greaterThan. 0) + ALSO(ssz .isAtMost. 64*8) ! default initialization check allocate(bytes(64)) bytes = transfer(lock, bytes) - diag = diag .and. & - assert_that( all(bytes == 0) ) + ALSO2(.all.(int(bytes) .equalsExpected. 0), "default initialization to zero") end function function check_notify_type() result(diag) - type(result_t) :: diag + type(test_diagnosis_t) :: diag type(prif_notify_type) :: notify integer :: ssz integer(int8), allocatable :: bytes(:) - diag = succeed("") + diag = .true. ! size check ssz = storage_size(notify) - diag = diag .and. & - assert_that(ssz > 0) .and. & - assert_that(ssz <= 64*8) + ALSO(ssz .greaterThan. 0) + ALSO(ssz .isAtMost. 64*8) ! default initialization check allocate(bytes(64)) bytes = transfer(notify, bytes) - diag = diag .and. & - assert_that( all(bytes == 0) ) + ALSO2(.all.(int(bytes) .equalsExpected. 0), "default initialization to zero") end function function check_critical_type() result(diag) - type(result_t) :: diag + type(test_diagnosis_t) :: diag type(prif_critical_type) :: critical integer :: ssz integer(int8), allocatable :: bytes(:) - diag = succeed("") + diag = .true. ! size check ssz = storage_size(critical) - diag = diag .and. & - assert_that(ssz > 0) .and. & - assert_that(ssz <= 64*8) + ALSO(ssz .greaterThan. 0) + ALSO(ssz .isAtMost. 64*8) ! default initialization check allocate(bytes(64)) bytes = transfer(critical, bytes) - diag = diag .and. & - assert_that( all(bytes == 0) ) + ALSO2(.all.(int(bytes) .equalsExpected. 0), "default initialization to zero") end function -end module prif_types_test +end module prif_types_test_m diff --git a/test/test-utils.F90 b/test/test-utils.F90 new file mode 100644 index 00000000..07d9fdd5 --- /dev/null +++ b/test/test-utils.F90 @@ -0,0 +1,23 @@ +#ifndef CPP_STRINGIFY_SOURCE +# if defined(__GFORTRAN__) || defined(_CRAYFTN) || defined(NAGFOR) || defined(__LFORTRAN__) +# define CPP_STRINGIFY_SOURCE(x) "x" +# else +# define CPP_STRINGIFY_SOURCE(x) #x +# endif +#endif + +#ifndef CPP_LINE_STRING +# if defined(__GFORTRAN__) + ! work-around Gfortran's defective preprocessor +# define CPP_LINE_STRING string_t(__LINE__) +# else +# define CPP_LINE_STRING_HELPER(n) CPP_STRINGIFY_SOURCE(n) +# define CPP_LINE_STRING CPP_LINE_STRING_HELPER(__LINE__) +# endif +#endif + +#define ALSO(exp) ALSO2(exp, "expression: (" // CPP_STRINGIFY_SOURCE(exp) // ")") +#define ALSO2(exp,desc) diag = diag .also. \ + ( test_diagnosis_t(exp, NEW_LINE('')) // \ + __FILE__ // ":" // CPP_LINE_STRING // ": FAILED: " // desc ) +