Merge pull request #8 from sourceryinstitute/c-preprocessor

fix(tests): use supported intrinsic procedures

Author: Damian Rouson

src/emulated_intrinsics_interface.F90

@@ -7,8 +7,10 @@
 module emulated_intrinsics_interface
   !! author: Damian Rouson
   !!
-  !! Emulations of some Fortran 2008 and 2018 instrinsic procedures for use with
-  !! compilers that lack support for the corresponding procedures.
+  !! This module contains two categories of procedures:
+  !! 1. Emulations of some Fortran 2008 and 2018 instrinsic procedures for use with
+  !!    compilers that lack support for the corresponding procedures.
+  !! 2. User-defined collective procedures not defined in the Fortran standard.
   implicit none
 
   interface

tests/collective_subroutines_test.f90 renamed to tests/collective_subroutines_test.F90

@@ -1,24 +1,19 @@
 module collective_subroutines_test
-    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
+    use Vegetables, only: Result_t, Test_Item_t, describe, it, assert_equals, assert_that, assert_not
+    use emulated_intrinsics_interface, only : &
+#ifdef COMPILER_LACKS_COLLECTIVE_SUBROUTINES
+    co_all, co_sum
+#else
+    co_all
+#endif
 
     implicit none
     private
 
-    public :: test_co_sum, test_co_all
-contains
-    function test_co_sum() result(tests)
-        type(Test_Item_t) :: tests
+    public :: test_co_all
+    public :: test_co_sum
 
-        tests = describe( &
-                "co_sum", &
-                [it( &
-                        "gives sums with result_image present", &
-                        check_co_sum_with_result_image), &
-                 it( &
-                        "gives sums without result_image present", &
-                        check_co_sum_without_result_image)])
-    end function
+contains
 
     function test_co_all() result(tests)
         type(Test_Item_t) :: tests
@@ -33,6 +28,38 @@ function test_co_all() result(tests)
                         check_co_all_with_one_false)])
     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
+
+    function test_co_sum() result(tests)
+        type(Test_Item_t) :: tests
+
+        tests = describe( &
+                "co_sum", &
+                [it( &
+                        "gives sums with result_image present", &
+                        check_co_sum_with_result_image), &
+                 it( &
+                        "gives sums without result_image present", &
+                        check_co_sum_without_result_image)])
+    end function
+
     function check_co_sum_with_result_image() result(result_)
         type(Result_t) :: result_
 
@@ -63,23 +90,4 @@ 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/single_image_intrinsics_test.f90 renamed to tests/single_image_intrinsics_test.F90

@@ -6,7 +6,9 @@
 !
 module single_image_intrinsics_test
     use Vegetables, only: Result_t, Test_Item_t, describe, it, assert_equals
+#ifdef COMPILER_LACKS_FINDLOC
     use emulated_intrinsics_interface, only : findloc
+#endif
 
     implicit none
     private
@@ -93,4 +95,3 @@ function check_nonexistent_character_value() result(result_)
   end function
 
 end module
-