Skip to content

Refactored FORTRAN module #173

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
Montana wants to merge 1 commit into from
Closed

Refactored FORTRAN module #173

Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
217 changes: 112 additions & 105 deletions test/caf_co_sum_test.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,150 +1,157 @@
module caf_co_sum_test
use prif, only : prif_co_sum, prif_num_images, prif_this_image_no_coarray
use veggies, only: result_t, test_item_t, assert_equals, describe, it, assert_that, assert_equals, succeed
use prif, only: prif_co_sum, prif_num_images, prif_this_image_no_coarray
use veggies, only: result_t, test_item_t, assert_equals, describe, it, assert_that, succeed

implicit none
private
public :: test_prif_co_sum

contains

! Main test function that aggregates all sub-tests for prif_co_sum
function test_prif_co_sum() result(tests)
type(test_item_t) tests
type(test_item_t) :: tests

tests = describe( &
"The prif_co_sum subroutine", &
[ it("sums default integer scalars with no optional arguments present", sum_default_integer_scalars) &
,it("sums default integer scalars with all arguments present", sum_integers_all_arguments) &
,it("sums integer(c_int64_t) scalars with stat argument present", sum_c_int64_scalars) &
,it("sums default integer 1D arrays with no optional arguments present", sum_default_integer_1D_array) &
,it("sums default integer 15D arrays with stat argument present", sum_default_integer_15D_array) &
,it("sums default real scalars with result_image argument present", sum_default_real_scalars) &
,it("sums double precision 2D arrays with no optional arguments present", sum_double_precision_2D_array) &
,it("sums default complex scalars with stat argument present", sum_default_complex_scalars) &
,it("sums double precision 1D complex arrays with no optional arguments present", sum_dble_complex_1D_arrays) &
])
end function

"The prif_co_sum subroutine", &
[ it("sums default integer scalars without optional arguments", sum_default_integer_scalars), &
it("sums default integer scalars with all arguments", sum_integers_all_arguments), &
it("sums integer(c_int64_t) scalars with stat argument", sum_c_int64_scalars), &
it("sums default integer 1D arrays without optional arguments", sum_default_integer_1D_array), &
it("sums default integer 15D arrays with stat argument", sum_default_integer_15D_array), &
it("sums default real scalars with result_image argument", sum_default_real_scalars), &
it("sums double precision 2D arrays without optional arguments", sum_double_precision_2D_array), &
it("sums default complex scalars with stat argument", sum_default_complex_scalars), &
it("sums double precision 1D complex arrays without optional arguments", sum_dble_complex_1D_arrays) &
])
end function test_prif_co_sum

! Test summation of default integer scalars
function sum_default_integer_scalars() result(result_)
type(result_t) result_
integer i, num_imgs
type(result_t) :: result_
integer :: scalar, num_imgs

i = 1
call prif_co_sum(i)
call prif_num_images(num_images=num_imgs)
result_ = assert_equals(num_imgs, i)
end function
scalar = 1
call prif_co_sum(scalar)
call prif_num_images(num_imgs)
result_ = assert_equals(num_imgs, scalar)
end function sum_default_integer_scalars

! Test summation of default integer scalars with all arguments
function sum_integers_all_arguments() result(result_)
type(result_t) result_
integer i, status_, result_image_, me, num_imgs
character(len=*), parameter :: whitespace = repeat(" ", ncopies=29)
character(len=:), allocatable :: error_message

i = 1
result_image_ = 1
status_ = -1
error_message = whitespace

call prif_this_image_no_coarray(this_image=me)
call prif_num_images(num_images=num_imgs)
associate(expected_i => merge(num_imgs*i, i, me==result_image_))
call prif_co_sum(i, result_image_, status_, error_message)
result_ = assert_equals(expected_i, i) .and. assert_equals(0, status_) .and. assert_equals(whitespace, error_message)
type(result_t) :: result_
integer :: scalar, status, result_image, num_imgs, this_img
character(len=29), parameter :: blank_msg = repeat(" ", 29)
character(len=:), allocatable :: error_msg

scalar = 1
result_image = 1
status = -1
error_msg = blank_msg

call prif_this_image_no_coarray(this_img)
call prif_num_images(num_imgs)
associate(expected_value => merge(num_imgs * scalar, scalar, this_img == result_image))
call prif_co_sum(scalar, result_image, status, error_msg)
result_ = assert_equals(expected_value, scalar) .and. &
assert_equals(0, status) .and. &
assert_equals(blank_msg, error_msg)
end associate
end function
end function sum_integers_all_arguments

! Test summation of c_int64_t scalars
function sum_c_int64_scalars() result(result_)
use iso_c_binding, only : c_int64_t
type(result_t) result_
integer(c_int64_t) i
integer i_default_kind, status_, num_imgs

status_ = -1
i = 2_c_int64_t
call prif_co_sum(i, stat=status_)
i_default_kind = i
call prif_num_images(num_images=num_imgs)
result_ = assert_equals(2*num_imgs, int(i)) .and. assert_equals(0, status_)
end function

use iso_c_binding, only: c_int64_t
type(result_t) :: result_
integer(c_int64_t) :: scalar
integer :: num_imgs, status

scalar = 2_c_int64_t
status = -1
call prif_co_sum(scalar, stat=status)
call prif_num_images(num_imgs)
result_ = assert_equals(2 * num_imgs, scalar) .and. assert_equals(0, status)
end function sum_c_int64_scalars

! Test summation of default integer 1D arrays
function sum_default_integer_1D_array() result(result_)
type(result_t) result_
integer i, images
type(result_t) :: result_
integer, allocatable :: array(:)
integer :: num_imgs, i

call prif_num_images(num_images=images)
associate(sequence_ => [(i,i=1,images)])
array = sequence_
call prif_co_sum(array)
result_ = assert_that(all(array==images*sequence_))
end associate
end function
call prif_num_images(num_imgs)
array = [(i, i = 1, num_imgs)]
call prif_co_sum(array)
result_ = assert_that(all(array == num_imgs * [(i, i = 1, num_imgs)]))
end function sum_default_integer_1D_array

! Test summation of default integer 15D arrays
function sum_default_integer_15D_array() result(result_)
type(result_t) result_
integer array(2,1,1, 1,1,1, 1,1,1, 1,1,1, 1,2,1)
integer status_, num_imgs
type(result_t) :: result_
integer :: array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1)
integer :: num_imgs, status

status_ = -1
array = 3
call prif_co_sum(array, stat=status_)
call prif_num_images(num_images=num_imgs)
result_ = assert_that(all(3*num_imgs == array)) .and. assert_equals(0, status_)
end function
status = -1
call prif_co_sum(array, stat=status)
call prif_num_images(num_imgs)
result_ = assert_that(all(array == 3 * num_imgs)) .and. assert_equals(0, status)
end function sum_default_integer_15D_array

! Test summation of default real scalars
function sum_default_real_scalars() result(result_)
type(result_t) result_
real scalar
type(result_t) :: result_
real :: scalar
real, parameter :: e = 2.7182818459045
integer result_image_, me, num_imgs
integer :: result_image, num_imgs, this_img

result_image_ = 1
scalar = e
call prif_co_sum(scalar, result_image=result_image_)
call prif_this_image_no_coarray(this_image=me)
call prif_num_images(num_images=num_imgs)
associate(expected_result => merge(num_imgs*e, e, me==result_image_))
result_ = assert_equals(dble(expected_result), dble(scalar))
result_image = 1
call prif_co_sum(scalar, result_image=result_image)
call prif_this_image_no_coarray(this_img)
call prif_num_images(num_imgs)
associate(expected_result => merge(num_imgs * e, e, this_img == result_image))
result_ = assert_equals(expected_result, scalar)
end associate
end function
end function sum_default_real_scalars

! Test summation of double precision 2D arrays
function sum_double_precision_2D_array() result(result_)
type(result_t) result_
type(result_t) :: result_
double precision, allocatable :: array(:,:)
double precision, parameter :: input(*,*) = reshape(-[6,5,4,3,2,1], [3,2])
double precision, parameter :: input(3,2) = reshape([-6, -5, -4, -3, -2, -1], [3,2])
integer :: num_imgs

array = input
call prif_co_sum(array)
call prif_num_images(num_images=num_imgs)
result_ = assert_equals(product(num_imgs*input), product(array))
end function
call prif_num_images(num_imgs)
result_ = assert_equals(array, num_imgs * input)
end function sum_double_precision_2D_array

! Test summation of default complex scalars
function sum_default_complex_scalars() result(result_)
type(result_t) result_
real scalar
complex z
complex, parameter :: i=(0.,1.)
integer status_, num_imgs

status_ = -1
z = i
call prif_co_sum(z, stat=status_)
call prif_num_images(num_images=num_imgs)
result_ = assert_equals(dble(abs(i*num_imgs)), dble(abs(z)) ) .and. assert_equals(0, status_)
end function

type(result_t) :: result_
complex :: scalar, i
integer :: num_imgs, status

scalar = (0.0, 1.0)
status = -1
call prif_co_sum(scalar, stat=status)
call prif_num_images(num_imgs)
result_ = assert_equals(abs(scalar), abs(num_imgs * (0.0, 1.0))) .and. assert_equals(0, status)
end function sum_default_complex_scalars

! Test summation of double precision 1D complex arrays
function sum_dble_complex_1D_arrays() result(result_)
type(result_t) result_
integer, parameter :: dp = kind(1.D0)
integer :: num_imgs
type(result_t) :: result_
integer, parameter :: dp = kind(1.0d0)
complex(dp), allocatable :: array(:)
complex(dp), parameter :: input(*) = [(1.D0,1.0D0)]
integer :: num_imgs

array = [(1.D0,1.D0)]
array = [(1.0_dp, 1.0_dp)]
call prif_co_sum(array)
call prif_num_images(num_images=num_imgs)
result_ = assert_that(all([input*num_imgs] == array))
end function
call prif_num_images(num_imgs)
result_ = assert_that(all(array == [(num_imgs * (1.0_dp, 1.0_dp))]))
end function sum_dble_complex_1D_arrays

end module caf_co_sum_test