Merge pull request #68 from sourceryinstitute/fixes-for-favpro

Improve testing of:
- Block partitioning
- Bin type
- Command Line processing

.github/workflows/CI.yml

@@ -9,39 +9,51 @@ jobs:
     env:
       FC: gfortran
       GCC_V: 13
+      OC_V: 2.10.2
 
     steps:
     - name: Checkout code
-      uses: actions/checkout@v3
+      uses: actions/checkout@v4
 
     - name: Install fpm
-      uses: fortran-lang/setup-fpm@v4
+      uses: fortran-lang/setup-fpm@v5
       with:
         github-token: ${{ secrets.GITHUB_TOKEN }}
 
-    - name: Get Time
-      id: time
-      uses: nanzm/get-time-action@v1.1
-      with:
-        format: 'YYYY-MM'
-
     - name: Setup cache for opencoarrays
       id: cache-opencoarrays
-      uses: actions/cache@v3
+      uses: actions/cache@v4
       with:
-        path: "OpenCoarrays-2.10.1/"
-        key: ${{ steps.time.outputs.time }}
+        path: "~/apps/OpenCoarrays/"
+        key: OC-${{ env.OC_V }}
 
-    - name: Install GFortran, OpenCoarrays
+    - name: Install GFortran
       run: |
         sudo apt update
-        sudo apt install -y build-essential gfortran-${GCC_V} g++-${GCC_V} pkg-config make
+        sudo apt install -y build-essential gfortran-${GCC_V} g++-${GCC_V} cmake mpich
         sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-${GCC_V} 100 \
           --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${GCC_V} \
           --slave /usr/bin/g++ g++ /usr/bin/g++-${GCC_V}
-        if [ ! -d OpenCoarrays-2.10.1 ] ; then wget -P . https://github.com/sourceryinstitute/OpenCoarrays/releases/download/2.10.1/OpenCoarrays-2.10.1.tar.gz && tar -xf OpenCoarrays-2.10.1.tar.gz && cd OpenCoarrays-2.10.1 && TERM=xterm ./install.sh -y; fi
+
+    - name: Maybe install opencoarrays
+      if: steps.cache-opencoarrays.outputs.cache-hit != 'true'
+      run: |
+        wget https://github.com/sourceryinstitute/OpenCoarrays/releases/download/${OC_V}/OpenCoarrays-${OC_V}.tar.gz
+        tar xzvf OpenCoarrays-${OC_V}.tar.gz
+        cd OpenCoarrays-${OC_V}
+        mkdir -p "~/apps/OpenCoarrays/${OC_V}"
+        cmake -S . -B build -DCMAKE_INSTALL_PREFIX="~/apps/OpenCoarrays/${OC_V}"
+        cmake --build build -t install -j
+        echo "${HOME}/apps/OpenCoarrays/${OC_V}/bin" >> $GITHUB_PATH
+
+    - name: Add to PATH if cache hit
+      if: steps.cache-opencoarrays.outputs.cache-hit == 'true'
+      run: echo "${HOME}/apps/OpenCoarrays/${OC_V}/bin" >> $GITHUB_PATH
 
     - name: Build, run, and test
       run: |
-        source OpenCoarrays-2.10.1/prerequisites/installations/opencoarrays/2.10.1/setup.sh
-        fpm test --compiler caf --runner "cafrun -n 2" 
+        which caf
+        caf --show
+        # Build the example executable to test the commandline without caf first, since you cannot spawn new MPI jobs from within an MPI job
+        fpm run --example get-flag-value -- --input-file some_file_name
+        fpm test --compiler caf --runner "cafrun -n 2"

test/bin_test.f90

@@ -29,11 +29,15 @@ function results() result(test_results)
       descriptions => &
         [ character(len=len(longest_description)) :: &
           "partitioning items nearly evenly across bins", &
-          "partitioning all item across all bins without item loss" &
+          "partitioning all item across all bins without item loss", &
+          "partitioning items such that each bin only has one works", &
+          "partitioning items such that some bins only have one works" &
         ], &
       outcomes => &
          [ verify_block_partitioning(), &
-           verify_all_items_partitioned() &
+           verify_all_items_partitioned(), &
+           verify_all_singleton_bins_are_ok(), &
+           verify_some_singleton_bins_are_ok() &
          ] &
      )
        call assert(size(descriptions) == size(outcomes), "bin_test_m(results): size(descriptions) == size(outcomes)")
@@ -73,4 +77,39 @@ function verify_all_items_partitioned() result(test_passes)
 
   end function
 
+  function verify_all_singleton_bins_are_ok() result(test_passes)
+    !! Verify that all singleton bins can be created and that the number of items equals the number of bins
+    type(bin_t) partition
+    logical test_passes
+
+    type(bin_t), allocatable :: bins(:)
+    integer, parameter :: n_items=11, n_bins=11
+    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
+
+  function verify_some_singleton_bins_are_ok() result(test_passes)
+    !! Verify that some singleton bins can be created and that the number of items equals the number of bins
+    type(bin_t) partition
+    logical test_passes
+
+    type(bin_t), allocatable :: bins(:), more_bins(:)
+    integer, parameter :: n_bins=11, n_items=(n_bins + (n_bins/2))
+    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
+
+    more_bins = [( bin_t(num_items=n_items, num_bins=n_bins, bin_number=b), b = 1,n_bins )]
+    associate(in_bin => [(more_bins(b)%last() - more_bins(b)%first() + 1, b = 1, n_bins)])
+      associate(remainder => mod(n_items, n_bins), items_per_bin => n_items/n_bins)
+        test_passes = test_passes .and. &
+          all([(in_bin(1:remainder) == items_per_bin + 1)]) .and. all([(in_bin(remainder+1:) == items_per_bin)])
+      end associate
+    end associate
+
+  end function
 end module bin_test_m

test/command_line_test.f90

@@ -33,10 +33,14 @@ function check_flag_value() result(test_passes)
     integer exit_status, command_status
     character(len=132) command_message
 
+    !! Can't spawn an MPI process from an MPI process, this will fail if example is compiled with MPI and the test is too.
+    !! This triggers a full rebuild of the library and example if using caf. This can cause problems in some circumstances.
+    !! Try to sanitize the environment and unset FPM_FC if it is caf.
     call execute_command_line( &
-      command = "fpm run --example get-flag-value -- --input-file some_file_name", &
+      command = "if [[ ${FPM_FC:-x} == *'caf' ]] ; then unset FPM_FC ; fi ; &
+        &fpm run --example get-flag-value -- --input-file some_file_name", &
       wait = .true., exitstat = exit_status, cmdstat = command_status, cmdmsg = command_message &
-    )   
+    )
     test_passes = exit_status == 0 
 
   end function

test/data_partition_test.f90

@@ -27,9 +27,19 @@ function results() result(test_results)
     type(test_result_t), allocatable :: test_results(:)
 
     test_results = [ &
-      test_result_t("partitioning data in nearly even blocks", verify_block_partitioning()), &
+      test_result_t("partitioning data in nearly even blocks", verify_block_partitioning(num_particles)), &
+      test_result_t("partitioning data in nearly even blocks when some blocks are singletons", &
+       verify_block_partitioning(num_images()+1)), &
+      test_result_t("bins of size 1 when set cardinality == num_images()", verify_block_partitioning_with_singletons()), &
       test_result_t("default image_number is this_image()", verify_default_image_number()), &
+      test_result_t("partitioning data into contiguous bins without overlap", &
+        verify_partitions_are_contiguous_without_overlap(num_particles)), &
+      test_result_t("contiguous non overlapping partitions with singletons", &
+        verify_partitions_are_contiguous_without_overlap(num_images())), &
+      test_result_t("contiguous non overlapping partitions with some singletons", &
+        verify_partitions_are_contiguous_without_overlap(num_images()+1)), &
       test_result_t("partitioning all data across all images without data loss", verify_all_particles_partitioned()), &
+      test_result_t("no data is lost when singleton bins are used", verify_all_particles_partitioned_on_singletons()), &
       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()), &
@@ -40,26 +50,96 @@ function results() result(test_results)
     ]
   end function
 
-  function verify_block_partitioning() result(test_passes)
+  function verify_testing_in_parallel() result(test_passes)
+    !! Verify that the test is being run in parallel
+    logical test_passes
+    test_passes = num_images() > 1
+  end function
+
+  function verify_block_partitioning(cardinality) result(test_passes)
     !! Verify that the data is partitioned across images evenly to
     !! within a difference of one datum between any two images.
+    integer, intent(in) :: cardinality
     type(data_partition_t) partition
     logical test_passes
     integer my_particles
 
+    associate( me=>this_image(), partition => data_partition_t(cardinality=cardinality))
+      associate( my_first=>partition%first(me), my_last=>partition%last(me) )
+        my_particles = my_last - my_first + 1
+        associate( ni=>num_images() )
+          associate( quotient=>cardinality/ni, remainder=>mod(cardinality,ni)  )
+            test_passes = quotient + merge(1, 0, me<=remainder) == my_particles
+          end associate
+        end associate
+      end associate
+    end associate
+
+  end function
+
+  function verify_block_partitioning_with_singletons() result(test_passes)
+    !! Verify that the data is partitioned so that each image has a bin of
+    !! size 1.
+    type(data_partition_t) partition, another_partition
+    logical test_passes
+    integer my_particles
+    integer num_particles
+
+    num_particles = num_images()
+    another_partition = data_partition_t(cardinality=num_particles)
+
     associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
       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)  )
-            test_passes = quotient + merge(1, 0, me<=remainder) == my_particles
+            test_passes = quotient == 1 &
+              .and. remainder == 0 &
+              .and. my_particles == 1 &
+              .and. my_last == my_first &
+              .and. my_first == me
           end associate
         end associate
       end associate
     end associate
 
   end function
 
+  function verify_partitions_are_contiguous_without_overlap(cardinality) result(test_passes)
+    !! Verify that the data is partitioned across images into contiguous bins without overlap
+    integer, intent(in) :: cardinality
+    logical test_passes
+    type(data_partition_t) partition
+
+    associate( me=>this_image(), partition => data_partition_t(cardinality=cardinality))
+      associate( my_first=>partition%first(me), my_last=>partition%last(me) )
+        associate(ni => num_images())
+          if (me > 1) then
+            associate( your_first=>partition%first(me-1), your_last=>partition%last(me-1) )
+                test_passes = my_first <= my_last &
+                .and. your_first <= your_last &
+                .and. my_first >= 1 &
+                .and. my_last <= cardinality &
+                .and. my_first == your_last + 1
+            end associate
+          else if (me == 1 .and. ni > 1) then
+            associate( your_first=>partition%first(me+1), your_last=>partition%last(me+1) )
+                test_passes = my_first <= my_last &
+                .and. your_first <= your_last &
+                .and. my_first >= 1 &
+                .and. my_last <= cardinality &
+                .and. my_last == your_first - 1
+            end associate
+          else if (ni == 1) then
+            test_passes = my_first <= my_last &
+            .and. my_first >= 1 &
+            .and. my_last <= cardinality
+          end if
+        end associate
+      end associate
+    end associate
+  end function
+
   function verify_default_image_number() result(test_passes)
     !! Verify that the first and last functions assume image_number == this_image() if image_number is not  present
     type(data_partition_t) partition
@@ -86,6 +166,26 @@ function verify_all_particles_partitioned() result(test_passes)
     end associate
   end function
 
+  function verify_all_particles_partitioned_on_singletons() result(test_passes)
+    !! Verify that the number of particles on each image sums to the
+    !! total number of particles distributed when the cardinality of the 
+    !! partitioned set is equal to num_images()
+    type(data_partition_t) partition
+    logical test_passes
+    integer particles
+    integer num_particles
+    num_particles = num_images()
+
+    associate( me=>this_image(), partition => data_partition_t(cardinality=num_particles))
+      associate( my_first=>partition%first(me), my_last=>partition%last(me) )
+        particles = my_last - my_first + 1
+        test_passes = particles == 1
+        call co_sum(particles)
+        test_passes = test_passes .and. num_particles == particles
+      end associate
+    end associate
+  end function
+
  function verify_all_gather_1D_real_array() result(test_passes)
    type(data_partition_t) partition
    logical test_passes

test/main.f90

@@ -29,7 +29,7 @@ program main
   call test_result_test%report(passes, tests)
   call string_test%report(passes, tests)
 
-  if (.not. GitHub_CI())  call command_line_test%report(passes, tests)
+  call command_line_test%report(passes, tests)
 
   if (this_image()==1) print *, new_line('a'), "_________ In total, ",passes," of ",tests, " tests pass. _________"