feat: rm data=partitioning test in test/main

Author: rouson

src/test_result_s.f90

@@ -9,7 +9,7 @@
     end procedure
 
     module procedure characterize
-      characterization = merge("passes on ", "fails on  ", self%passed_) // self%description_ // "."
+      characterization = merge("passes on ", "FAILS on  ", self%passed_) // self%description_ // "."
     end procedure
 
 end submodule test_result_s

tests/data_partition_test.f90

@@ -1,155 +1,129 @@
 module data_partition_test
-   !! author: Damian Rouson
-   !!
-   !! summary: verify data partitioning across images and data gathering
-   use vegetables, only: &
-     result_t, example_t, input_t, integer_input_t, test_item_t, & ! types
-     describe, it, assert_equals, assert_that  ! functions
-   use data_partition_m, only : data_partition_t
-   use iso_fortran_env, only : real64
-   implicit none
-
-   private
-   public :: test_data_partition
+  !! verify data partitioning across images and data gathering
+  use data_partition_m, only : data_partition_t
+  use test_m, only : test_t, test_result_t
+  use iso_fortran_env, only : real64
+  implicit none
 
-   type(data_partition_t) partition
-   integer, parameter :: num_particles=31, gatherer=1, num_steps=9, dummy=0
+  private
+  public :: data_partition_test_t
+
+  type, extends(test_t) :: data_partition_test_t
+  contains
+    procedure, nopass :: subject
+    procedure, nopass :: results
+  end type
+
+  type(data_partition_t) partition
+  integer, parameter :: num_particles=31, gatherer=1, num_steps=9, dummy=0
 
 contains
 
-  function test_data_partition() result(tests)
-    type(test_item_t) tests
+  pure function subject() result(specimen)
+    character(len=:), allocatable :: specimen
+    specimen = "The data_partition_t type" 
+  end function
+
+  function results() result(test_results)
+    type(test_result_t), allocatable :: test_results(:)
 
-    call partition%define_partitions( cardinality=num_particles)
+    call partition%define_partitions(cardinality=num_particles)
 
     associate( me=>this_image() )
       associate( my_first=>partition%first(me), my_last=>partition%last(me) )
-        tests = describe( &
-         "data_partition class", &
-         [it( &
-           "partitions data in nearly even blocks", &
-           verify_block_partitioning), &
-          it( &
-           "all data partitioned across all images without data loss", &
-           verify_all_particles_partitioned), &
-          it( &
-           "1D real array gathered on all images", &
-           [example_t(integer_input_t(dummy)), example_t(integer_input_t(dummy))], &
-           verify_all_gather_1D_real_array), &
-          it( &
-           "dimension 1 of 2D real array gathered on all images witout dim argument", &
-           [example_t(integer_input_t(dummy)), example_t(integer_input_t(dummy))], &
-           verify_all_gather_2D_real_array), &
-          it( &
-           "dimension 1 of 2D real array gathered on all images with dim argument", &
-           [example_t(integer_input_t(dummy)), example_t(integer_input_t(dummy))], &
-           verify_all_gather_2D_real_array_dim1), &
-          it( &
-           "dimension 1 of 2D real array gathered onto result_image with dim argument", &
-           [example_t(integer_input_t(dummy)), example_t(integer_input_t(dummy))], &
-           verify_gather_2D_real_array_dim1)])
-
+        test_results = [ &
+          test_result_t("partitioning data in nearly even blocks", verify_block_partitioning()), &
+          test_result_t("partitioning all data across all images without data loss", verify_all_particles_partitioned()), &
+          test_result_t("gathering a 1D real array onto all images", verify_all_gather_1D_real_array()), &
+          test_result_t("gathering dimension 1 of 2D real array onto all images witout dim argument", &
+            verify_all_gather_2D_real_array()), &
+          test_result_t("gathering dimension 1 of 2D real array onton all images with dim argument", &
+            verify_all_gather_2D_real_array_dim1()), &
+          test_result_t("gathering dimension 1 of 2D real array onto result_image with dim argument", &
+            verify_gather_2D_real_array_dim1()) &
+        ]
       end associate
     end associate
   end function
 
-  function verify_block_partitioning() result(result_)
+  function verify_block_partitioning() result(test_passes)
     !! Verify that the data is partitioned across images evenly to
     !! within a difference of one datum between any two images.
     type(data_partition_t) partition
-    type(result_t) result_
+    logical test_passes
     integer my_particles
 
     associate( me=>this_image() )
       associate( my_first=>partition%first(me), my_last=>partition%last(me) )
         my_particles = my_last - my_first + 1
         associate( ni=>num_images() )
           associate( quotient=>num_particles/ni, remainder=>mod(num_particles,ni)  )
-            result_ = assert_equals( quotient + merge(1, 0, me<=remainder), my_particles, "block distribution" )
+            test_passes = quotient + merge(1, 0, me<=remainder) == my_particles
           end associate
         end associate
       end associate
     end associate
   end function
 
-  function verify_all_particles_partitioned() result(result_)
+  function verify_all_particles_partitioned() result(test_passes)
     !! Verify that the number of particles on each image sums to the
     !! total number of particles distributed.
     type(data_partition_t) partition
-    type(result_t) result_
+    logical test_passes
     integer particles
 
     associate(me => this_image())
       associate( my_first=>partition%first(me), my_last=>partition%last(me) )
         particles = my_last - my_first + 1
         call co_sum(particles)
-        result_ = assert_equals(num_particles, particles, "all particles distributed" )
+        test_passes = num_particles == particles
       end associate
     end associate
   end function
 
- function verify_all_gather_1D_real_array(unused) result(result_)
+ function verify_all_gather_1D_real_array() result(test_passes)
    type(data_partition_t) partition
-   class(input_t), intent(in) :: unused
-   type(result_t) result_
+   logical test_passes
    real(real64) :: particle_scalar(num_particles)
    real(real64), parameter :: junk=-12345._real64, expected=1._real64
 
-   associate( no_op => unused) ! eliminate unused-variable warning
-   end associate
-
    associate(me => this_image())
      associate( first=>partition%first(me), last=>partition%last(me) )
-
        particle_scalar(first:last) = expected !! values to be gathered
        particle_scalar(1:first-1)  = junk !! values to be overwritten by the gather
        particle_scalar(last+1:)  = junk !! values to be overwritten by the gather
-
        call partition%gather(particle_scalar)
-
-       result_ = assert_that( all(particle_scalar==expected), "real 1D array all-gathered" )
-
+       test_passes = all(particle_scalar==expected)
      end associate
    end associate
  end function
 
- function verify_all_gather_2D_real_array(unused) result(result_)
-   class(input_t), intent(in) :: unused
+ function verify_all_gather_2D_real_array() result(test_passes)
    type(data_partition_t) partition
-   type(result_t) result_
+   logical test_passes
    integer, parameter :: vec_space_dim=3
    real(real64) particle_vector(vec_space_dim, num_particles)
    real(real64), parameter :: junk=-12345._real64, expected=1._real64
 
-   associate( no_op => unused) ! eliminate unused-variable warning
-   end associate
-
    associate(me => this_image())
      associate( first=>partition%first(me), last=>partition%last(me) )
 
        particle_vector(:, first:last) = expected !! values to be gathered
        particle_vector(:, 1:first-1)  = junk !! values to be overwritten by the gather
        particle_vector(:, last+1:)  = junk !! values to be overwritten by the gather
-
        call partition%gather(particle_vector)
-
-       result_ = assert_that(all(particle_vector==expected), "real 2D array all-gathered implicitly along dimension 1" )
-
+       test_passes = all(particle_vector==expected)
      end associate
    end associate
  end function
 
- function verify_all_gather_2D_real_array_dim1(unused) result(result_)
-   class(input_t), intent(in) :: unused
+ function verify_all_gather_2D_real_array_dim1() result(test_passes)
    type(data_partition_t) partition
-   type(result_t) result_
+   logical test_passes
    integer, parameter :: vec_space_dim=3
    real(real64) :: vector_transpose(num_particles, vec_space_dim)
    real(real64), parameter :: junk=-12345._real64, expected=1._real64
 
-   associate( no_op => unused) ! eliminate unused-variable warning
-   end associate
-
    associate(me => this_image())
      associate( first=>partition%first(me), last=>partition%last(me) )
 
@@ -159,23 +133,19 @@ function verify_all_gather_2D_real_array_dim1(unused) result(result_)
 
        call partition%gather( vector_transpose, dim=1)
 
-       result_ = assert_that(all(vector_transpose==expected), "vector_transpose gathered explicitly along dimension 1" )
+       test_passes= all(vector_transpose==expected)
 
       end associate
     end associate
  end function
 
- function verify_gather_2D_real_array_dim1(unused) result(result_)
-   class(input_t), intent(in) :: unused
+ function verify_gather_2D_real_array_dim1() result(test_passes)
    type(data_partition_t) partition
-   type(result_t) result_
+   logical test_passes
    integer, parameter :: vec_space_dim=3
    real(real64) :: vector_transpose(num_particles, vec_space_dim)
    real(real64), parameter :: junk=-12345._real64, expected=1._real64
 
-   associate( no_op => unused) ! eliminate unused-variable warning
-   end associate
-
    associate(me => this_image())
      associate( first=>partition%first(me), last=>partition%last(me) )
 
@@ -186,12 +156,12 @@ function verify_gather_2D_real_array_dim1(unused) result(result_)
        call partition%gather( vector_transpose, result_image=gatherer, dim=1)
 
        if (me==gatherer) then
-         result_ = assert_that(all(vector_transpose==expected), "all( particle_vector==expected)")
+         test_passes = all(vector_transpose==expected)
        else
-         result_ = &
-           assert_that(all(vector_transpose(1:first-1,:)==junk), "lower transpose data unchanged)") .and. &
-           assert_that(all(vector_transpose(first:last,:)==expected), "expected transpose data gathered") .and. &
-           assert_that(all(vector_transpose(last+1:,:)==junk), "upper transpose data unchanged)" )
+         test_passes = &
+           all(vector_transpose(1:first-1,:)==junk) .and. &
+           all(vector_transpose(first:last,:)==expected) .and. &
+           all(vector_transpose(last+1:,:)==junk)
        end if
 
      end associate

tests/main.f90

@@ -1,25 +1,17 @@
-! Generated by make_vegetable_driver. DO NOT EDIT
 program main
-    implicit none
-
-    call run()
-contains
-    subroutine run()
-        use data_partition_test, only: &
-                data_partition_data_partition => &
-                    test_data_partition
-        use vegetables, only: test_item_t, test_that, run_tests
-
-
-
-        type(test_item_t) :: tests
-        type(test_item_t) :: individual_tests(1)
-
-        individual_tests(1) = data_partition_data_partition()
-        tests = test_that(individual_tests)
-
-
-        call run_tests(tests)
-
-    end subroutine
+  use user_defined_collectives_test, only : collectives_test_t  
+  use data_partition_test, only : data_partition_test_t
+  use object_m_test, only : object_test_t  
+  use formats_test, only : formats_test_t  
+  implicit none
+
+  type(data_partition_test_t) data_partition_test
+  type(collectives_test_t) collectives_test
+  type(object_test_t) object_test
+  type(formats_test_t) formats_test
+
+  call data_partition_test%report()
+  call collectives_test%report()
+  call object_test%report()
+  call formats_test%report()
 end program

tests/object_m_test.f90

@@ -29,8 +29,8 @@ pure function results() result(test_results)
     type(test_result_t), allocatable :: test_results(:)
 
     test_results = [ &
-      test_result_t(".not. user_defined() if only default-initialized", check_default_initialization()), &
-      test_result_t("user_defined() after call mark_as_defined", check_mark_as_defined()) &
+      test_result_t("object being .not. user_defined() if it is only default-initialized", check_default_initialization()), &
+      test_result_t("object being user_defined() after call to mark_as_defined", check_mark_as_defined()) &
     ]
   end function