Skip to content

Commit

Permalink
test(co_reduce): report test failure diagnostics
Browse files Browse the repository at this point in the history
  • Loading branch information
rouson committed Jan 6, 2025
1 parent 8a74c08 commit fcf2fa8
Showing 1 changed file with 93 additions and 38 deletions.
131 changes: 93 additions & 38 deletions test/prif_co_reduce_test_m.F90
Original file line number Diff line number Diff line change
Expand Up @@ -8,9 +8,9 @@ module prif_co_reduce_test_m
use prif, only : prif_co_reduce, prif_num_images, prif_this_image_no_coarray, prif_error_stop, prif_co_max
use prif_test_m, only : prif_test_t, test_description_substring
use iso_c_binding, only : c_bool, c_funloc, c_char, c_double, c_int64_t
use julienne_m, only : test_result_t, test_description_t
use julienne_m, only : test_result_t, test_description_t, test_diagnosis_t, string_t, operator(.csv.)
#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY
use julienne_m, only : test_function_i
use julienne_m, only : diagnosis_function_i
#endif
implicit none

Expand Down Expand Up @@ -47,7 +47,7 @@ function results() result(test_results)
,test_description_t("alphabetical reduction of strings with result_image present", alphabetically_first_string) &
]
#else
procedure(test_function_i), pointer :: &
procedure(diagnosis_function_i), pointer :: &
alphabetically_first_string_ptr => alphabetically_first_string &
,sum_default_integer_scalars_ptr => sum_default_integer_scalars &
,sum_c_int64_t_scalars_ptr => sum_c_int64_t_scalars &
Expand Down Expand Up @@ -78,8 +78,8 @@ function results() result(test_results)
test_results = test_descriptions%run()
end function

function alphabetically_first_string() result(test_passes)
logical test_passes
function alphabetically_first_string() result(test_diagnosis)
type(test_diagnosis_t) test_diagnosis
character(len=*, kind=c_char), parameter :: names(*) = ["larry","harry","carey","betty","tommy","billy"]
character(len=len(names), kind=c_char) my_name, expected_name
integer :: me, n
Expand All @@ -92,8 +92,10 @@ function alphabetically_first_string() result(test_passes)

call prif_num_images(num_images=n)
expected_name = minval(names(1:min(n, size(names)))) ! this exposes a flang bug
test_passes = expected_name == my_name

test_diagnosis = test_diagnosis_t( &
test_passed = expected_name == my_name &
,diagnostics_string = "expected: " // expected_name // ", got: " // my_name &
)
contains

function alphabetize(lhs, rhs) result(first_alphabetically)
Expand All @@ -105,16 +107,23 @@ function alphabetize(lhs, rhs) result(first_alphabetically)

end function

function sum_integer_array_elements() result(test_passes)
logical test_passes
function sum_integer_array_elements() result(test_diagnosis)
type(test_diagnosis_t) test_diagnosis
integer status_, num_imgs
integer, parameter :: input_array(*,*) = reshape([1, 2, 3, 4], [2, 2])
integer array(2,2)
integer, dimension(*,*), parameter :: input_array = reshape([1, 2, 3, 4], [2, 2])
integer, dimension(2,2), target :: array, expected_array
integer, dimension(:), pointer :: expected_array_1D_ptr, array_1D_ptr

array = input_array
call prif_co_reduce(array, c_funloc(add_integers))
call prif_num_images(num_images=num_imgs)
test_passes = all(num_imgs*input_array==array)
expected_array = num_imgs*input_array
expected_array_1D_ptr(1:size(input_array)) => expected_array
array_1D_ptr(1:size(array)) => array
test_diagnosis = test_diagnosis_t( &
test_passed = all(array==expected_array) &
,diagnostics_string = "expected " // .csv. string_t(expected_array_1D_ptr) // ", actual " // .csv. string_t(array_1D_ptr) &
)

contains

Expand All @@ -126,16 +135,25 @@ pure function add_integers(lhs, rhs) result(total)

end function

function sum_complex_c_double_scalars() result(test_passes)
logical test_passes
function sum_complex_c_double_scalars() result(test_diagnosis)
type(test_diagnosis_t) test_diagnosis
integer status_, num_imgs
complex(c_double) z
complex(c_double), parameter :: z_input=(1._c_double, 1._c_double)
real(c_double), parameter :: tolerance = 1.e-14_c_double

z = z_input
call prif_co_reduce(z, c_funloc(add_complex), stat=status_)
call prif_num_images(num_images=num_imgs)
test_passes = real(num_imgs*z_input, c_double) == real(z, c_double) .and. status_ == 0

associate(expected => num_imgs*z_input)
test_diagnosis = test_diagnosis_t( &
test_passed = (abs(num_imgs*z_input - z) < tolerance) .and. (status_ == 0)&
,diagnostics_string = &
"expected " // string_t(expected) // " and status_= 0" &
// "; actual " // string_t(z) // " and status_= " // string_t(status_) &
)
end associate

contains

Expand All @@ -147,16 +165,24 @@ pure function add_complex(lhs, rhs) result(total)

end function

function sum_default_complex_scalars() result(test_passes)
logical test_passes
function sum_default_complex_scalars() result(test_diagnosis)
type(test_diagnosis_t) test_diagnosis
integer status_, num_imgs
complex z
complex, parameter :: z_input=(1.,1.)
real, parameter :: tolerance = 1E-07

z = z_input
call prif_co_reduce(z, c_funloc(add_complex), stat=status_)
call prif_num_images(num_images=num_imgs)
test_passes = dble(num_imgs*z_input) == dble(z) .and. status_ == 0

associate(expected => num_imgs*z_input)
test_diagnosis = test_diagnosis_t( &
test_passed = abs(z - expected) < tolerance .and. status_ == 0 &
,diagnostics_string = "expected " // string_t(expected) // " and status_= 0" &
// "; actual " // string_t( z) // " and status_= " // string_t(status_) &
)
end associate

contains

Expand All @@ -168,15 +194,18 @@ pure function add_complex(lhs, rhs) result(total)

end function

function sum_default_integer_scalars() result(test_passes)
logical test_passes
function sum_default_integer_scalars() result(test_diagnosis)
type(test_diagnosis_t) test_diagnosis
integer i, num_imgs

i = 1
call prif_co_reduce(i, c_funloc(add))
call prif_num_images(num_images=num_imgs)
test_passes = num_imgs == i

test_diagnosis = test_diagnosis_t( &
test_passed = i == num_imgs &
,diagnostics_string = "expected " // string_t(num_imgs) // ", actual " // string_t(i) &
)
contains

pure function add(lhs, rhs) result(total)
Expand All @@ -187,15 +216,21 @@ pure function add(lhs, rhs) result(total)

end function

function sum_c_int64_t_scalars() result(test_passes)
logical test_passes
function sum_c_int64_t_scalars() result(test_diagnosis)
type(test_diagnosis_t) test_diagnosis
integer(c_int64_t) i
integer :: num_imgs

i = 1_c_int64_t
call prif_co_reduce(i, c_funloc(add))
call prif_num_images(num_images=num_imgs)
test_passes = int(num_imgs, c_int64_t) == i

associate(expected => int(num_imgs, c_int64_t))
test_diagnosis = test_diagnosis_t( &
test_passed = i == int(num_imgs,c_int64_t) &
,diagnostics_string = "expected " // string_t(int(expected)) // ", actual " // string_t(int(i)) &
)
end associate

contains

Expand All @@ -207,10 +242,11 @@ pure function add(lhs, rhs) result(total)

end function

function reports_on_consensus() result(test_passes)
logical test_passes
function reports_on_consensus() result(test_diagnosis)
type(test_diagnosis_t) test_diagnosis
logical(c_bool) one_false, one_true, all_true
logical(c_bool), parameter :: c_true=.true._c_bool, c_false=.false._c_bool
character(len=1), parameter :: c_true_char='T', c_false_char='F'
logical ans1, ans2, ans3
integer :: me, num_imgs

Expand All @@ -226,10 +262,19 @@ function reports_on_consensus() result(test_passes)
call prif_co_reduce(all_true, c_funloc(logical_and))
call prif_num_images(num_images=num_imgs)

ans1 = one_false .eqv. c_false
ans2 = one_true .eqv. merge(c_true,c_false,num_imgs==1)
ans3 = all_true .eqv. c_true
test_passes = ans1 .and. ans2 .and. ans3
associate(expected_one_true => merge(c_true,c_false,num_imgs==1))

ans1 = one_false .eqv. c_false
ans2 = one_true .eqv. expected_one_true
ans3 = all_true .eqv. c_true

test_diagnosis = test_diagnosis_t( &
test_passed = ans1 .and. ans2 .and. ans3 &
,diagnostics_string = &
"expected one_false " // "F" // ", one_true " // "T" // ", all_true " // "T" //&
"; actual one_false " // string_t(one_false) // ", one_true " // string_t(one_true) // ", all_true " //string_t(all_true)&
)
end associate

contains

Expand All @@ -241,9 +286,10 @@ pure function logical_and(lhs, rhs) result(lhs_and_rhs)

end function

function multiply_c_double_scalars() result(test_passes)
logical test_passes
function multiply_c_double_scalars() result(test_diagnosis)
type(test_diagnosis_t) test_diagnosis
real(c_double) p
real(c_double), parameter :: tolerance = 1D-14
integer j, status_, me, num_imgs
character(len=:), allocatable :: error_message

Expand All @@ -253,7 +299,11 @@ function multiply_c_double_scalars() result(test_passes)
call prif_co_reduce(p, c_funloc(multiply_doubles), result_image=1, stat=status_, errmsg=error_message)
call prif_num_images(num_images=num_imgs)
associate(expected_result => merge( product([(real(j,c_double), j = 1, num_imgs)]), real(me,c_double), me==1 ))
test_passes = (expected_result == real(p,c_double)) .and. (0 == status_) .and. ("unused" == error_message)
test_diagnosis = test_diagnosis_t( &
test_passed = abs(expected_result - real(p,c_double)) < tolerance .and. (0 == status_) .and. ("unused" == error_message) &
,diagnostics_string = "expected " // string_t(expected_result) // " and status_= 0 " &
// "; actual " // string_t(p) // " and status_= " // string_t(status_) &
)
end associate

contains
Expand All @@ -266,9 +316,10 @@ pure function multiply_doubles(lhs, rhs) result(product_)

end function

function multiply_default_real_scalars() result(test_passes)
logical test_passes
function multiply_default_real_scalars() result(test_diagnosis)
type(test_diagnosis_t) test_diagnosis
real p
real, parameter :: tolerance = 1E-07
integer j, status_, me, num_imgs
character(len=:), allocatable :: error_message

Expand All @@ -277,8 +328,12 @@ function multiply_default_real_scalars() result(test_passes)
p = real(me)
call prif_co_reduce(p, c_funloc(multiply), result_image=1, stat=status_, errmsg=error_message)
call prif_num_images(num_images=num_imgs)
associate(expected_result => merge( product([(dble(j), j = 1, num_imgs)]), dble(me), me==1 ))
test_passes = (expected_result == dble(p)) .and. (0 == status_) .and. ("unused" == error_message)
associate(expected => merge( product([(dble(j), j = 1, num_imgs)]), dble(me), me==1 ))
test_diagnosis = test_diagnosis_t( &
test_passed = abs(expected - p) < tolerance .and. (0 == status_) .and. ("unused" == error_message) &
,diagnostics_string = "expected " // string_t(expected) // " and status_=0" &
// "; actual " // string_t(p) // " and status_=" // string_t(status_) &
)
end associate

contains
Expand All @@ -291,4 +346,4 @@ pure function multiply(lhs, rhs) result(product_)

end function

end module prif_co_reduce_test_m
end module prif_co_reduce_test_m

0 comments on commit fcf2fa8

Please sign in to comment.