diff --git a/src/emulated_intrinsics_interface.F90 b/src/emulated_intrinsics_interface.F90 index 3d9e6009..2b2e365b 100644 --- a/src/emulated_intrinsics_interface.F90 +++ b/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 diff --git a/tests/collective_subroutines_test.f90 b/tests/collective_subroutines_test.F90 similarity index 86% rename from tests/collective_subroutines_test.f90 rename to tests/collective_subroutines_test.F90 index ead5aa75..0de9460b 100644 --- a/tests/collective_subroutines_test.f90 +++ b/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 diff --git a/tests/single_image_intrinsics_test.f90 b/tests/single_image_intrinsics_test.F90 similarity index 99% rename from tests/single_image_intrinsics_test.f90 rename to tests/single_image_intrinsics_test.F90 index 87908933..84452e7d 100644 --- a/tests/single_image_intrinsics_test.f90 +++ b/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 -