Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 4 additions & 2 deletions src/emulated_intrinsics_interface.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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_

Expand Down Expand Up @@ -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
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -93,4 +95,3 @@ function check_nonexistent_character_value() result(result_)
end function

end module