refac(bin_test): enable selective testing

Author: rouson

test/bin_test.F90

@@ -0,0 +1,77 @@
+module bin_test_m
+  !! Check data partitioning across bins
+  use sourcery_m, only : bin_t, test_t, test_result_t, test_description_t, test_description_substring, test_function_i, string_t
+  use assert_m, only : assert
+  implicit none
+
+  private
+  public :: bin_test_t
+
+  type, extends(test_t) :: bin_test_t
+  contains
+    procedure, nopass :: subject
+    procedure, nopass :: results
+  end type
+
+contains
+
+  pure function subject() result(specimen)
+    character(len=:), allocatable :: specimen
+    specimen = "An array of bin_t objects (bins)" 
+  end function
+
+  function results() result(test_results)
+    type(test_result_t), allocatable :: test_results(:)
+    type(test_description_t), allocatable :: test_descriptions(:)
+
+#ifndef __GFORTRAN__
+    test_descriptions = [ & 
+      test_description_t(string_t("partitioning items nearly evenly across bins"), check_block_partitioning), &
+      test_description_t(string_t("partitioning all item across all bins without item loss"), check_all_items_partitioned) &
+    ]   
+#else
+    ! Work around missing Fortran 2008 feature: associating a procedure actual argument with a procedure pointer dummy argument:
+    procedure(test_function_i), pointer :: check_block_partitioning_ptr, check_all_items_ptr 
+    check_block_partitioning_ptr => check_block_partitioning
+    check_all_items_ptr => check_all_items_partitioned
+    test_descriptions = [ & 
+      test_description_t(string_t("partitioning items nearly evenly across bins"), check_block_partitioning_ptr), &
+      test_description_t(string_t("partitioning all item across all bins without item loss"), check_all_items_ptr) &
+    ]   
+#endif
+    test_descriptions = pack(test_descriptions, test_descriptions%contains_text(string_t(test_description_substring)))
+    test_results = test_descriptions%run()
+  end function
+
+  function check_block_partitioning() result(test_passes)
+    !! Check that the items are partitioned across bins evenly to within a difference of one item per bin
+    logical test_passes
+
+    type(bin_t), allocatable :: bins(:)
+    integer, parameter :: n_items=11, n_bins=7
+    integer b
+
+    bins = [( bin_t(num_items=n_items, num_bins=n_bins, bin_number=b), b = 1,n_bins )]
+    associate(in_bin => [(bins(b)%last() - bins(b)%first() + 1, b = 1, n_bins)])
+      associate(remainder => mod(n_items, n_bins), items_per_bin => n_items/n_bins)
+        test_passes = all([(in_bin(1:remainder) == items_per_bin + 1)]) .and. all([(in_bin(remainder+1:) == items_per_bin)])
+      end associate
+    end associate
+
+  end function
+
+  function check_all_items_partitioned() result(test_passes)
+    !! Check that the number of items in each bin sums to the total number of items
+    type(bin_t) partition
+    logical test_passes
+
+    type(bin_t), allocatable :: bins(:)
+    integer, parameter :: n_items=11, n_bins=6
+    integer b
+
+    bins = [( bin_t(num_items=n_items, num_bins=n_bins, bin_number=b), b = 1,n_bins )]
+    test_passes = sum([(bins(b)%last() - bins(b)%first() + 1, b = 1, n_bins)]) == n_items
+
+  end function
+
+end module bin_test_m