test(co_all): add unit tests

Author: Damian Rouson

src/emulated_intrinsics_implementation.F90

@@ -10,7 +10,14 @@
 
 contains
 
-  module procedure dummy
+  module procedure co_all
+      call co_reduce(boolean, both)
+  contains
+    pure function both(lhs,rhs) result(lhs_and_rhs)
+      logical, intent(in) :: lhs,rhs
+      logical lhs_and_rhs
+      lhs_and_rhs = lhs .and. rhs
+    end function
   end procedure
 
 #ifdef COMPILER_LACKS_COLLECTIVE_SUBROUTINES

src/emulated_intrinsics_interface.F90

@@ -12,8 +12,9 @@ module emulated_intrinsics_interface
   implicit none
 
   interface
-    module subroutine dummy
-      !! ensure a non-empty module
+    module subroutine co_all(boolean)
+      implicit none
+      logical, intent(inout) :: boolean
     end subroutine
   end interface
 

tests/collective_subroutines_test.f90

@@ -1,26 +1,39 @@
 module collective_subroutines_test
-    use Vegetables, only: Result_t, Test_Item_t, describe, it, succeed, assert_equals
+    use Vegetables, only: Result_t, Test_Item_t, describe, it, succeed, assert_equals, assert_that, assert_not
+    use emulated_intrinsics_interface, only : co_sum, co_all
 
     implicit none
     private
 
-    public :: test_collective_subroutines
+    public :: test_co_sum, test_co_all
 contains
-    function test_collective_subroutines() result(tests)
+    function test_co_sum() result(tests)
         type(Test_Item_t) :: tests
 
-        tests = describe(&
+        tests = describe( &
                 "co_sum", &
                 [it( &
-                        "gives the correct answer with result_image present", &
+                        "gives sums with result_image present", &
                         check_co_sum_with_result_image), &
                  it( &
-                        "gives the correct answer without result_image present", &
+                        "gives sums without result_image present", &
                         check_co_sum_without_result_image)])
     end function
 
+    function test_co_all() result(tests)
+        type(Test_Item_t) :: tests
+
+        tests = describe( &
+                "co_all", &
+                [it( &
+                        "sets all arguments to .true. when previously .true. on all images", &
+                        check_co_all_with_all_true), &
+                 it( &
+                        "sets all arguments to .false. when previously .false. on image 1", &
+                        check_co_all_with_one_false)])
+    end function
+
     function check_co_sum_with_result_image() result(result_)
-        use emulated_intrinsics_interface, only : co_sum
         type(Result_t) :: result_
 
         integer i, j
@@ -38,7 +51,6 @@ function check_co_sum_with_result_image() result(result_)
     end function
 
     function check_co_sum_without_result_image() result(result_)
-        use emulated_intrinsics_interface, only : co_sum
         type(Result_t) :: result_
 
         integer i, j
@@ -51,4 +63,23 @@ function check_co_sum_without_result_image() result(result_)
         end associate
     end function
 
+    function check_co_all_with_all_true() result(result_)
+        type(Result_t) :: result_
+        logical all_true
+
+        all_true=.true.
+
+        call co_all(all_true)
+        result_ = assert_that(all_true, "co_all argument remains .true. after call with all arguments true")
+    end function
+
+    function check_co_all_with_one_false() result(result_)
+        type(Result_t) :: result_
+        logical all_true
+
+        all_true = merge(.false., .true., this_image()==1)
+        call co_all(all_true)
+        result_ = assert_not(all_true, "co_all argument is .false. after call with one argument false")
+    end function
+
 end module

tests/main.f90

@@ -6,13 +6,15 @@ program main
 contains
     subroutine run()
         use collective_subroutines_test, only: &
-                collective_subroutines_collective_subroutines => test_collective_subroutines
+                collective_subroutines_co_sum => test_co_sum, &
+                collective_subroutines_co_all => test_co_all
         use vegetables, only: test_item_t, test_that, run_tests
 
         type(test_item_t) :: tests
-        type(test_item_t) :: individual_tests(1)
+        type(test_item_t) :: individual_tests(2)
 
-        individual_tests(1) = collective_subroutines_collective_subroutines()
+        individual_tests(1) = collective_subroutines_co_sum()
+        individual_tests(2) = collective_subroutines_co_all()
         tests = test_that(individual_tests)
 
         call run_tests(tests)