Skip to content

Commit 93afab7

Browse files
everythingfunctionaleverythingfunctional
committed
feat: begin illustrating how to splice into veggies to work with prif
1 parent 52d1324 commit 93afab7

File tree

6 files changed

+1124
-2
lines changed

6 files changed

+1124
-2
lines changed

‎test/a00_caffeinate_test.f90

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
module a00_caffeinate_test
22
use prif, only : prif_init, PRIF_STAT_ALREADY_INIT
3-
use veggies, only: test_item_t, describe, result_t, it, assert_that
3+
use veggies, only: test_item_t, result_t, assert_that
4+
use prif_veggies, only: describe, it
45

56
implicit none
67
private

‎test/main.f90

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,8 @@ function run() result(passed)
6060
use caf_this_image_test, only: &
6161
caf_this_image_prif_this_image_no_coarray => &
6262
test_prif_this_image_no_coarray
63-
use veggies, only: test_item_t, test_that, run_tests
63+
use veggies, only: test_item_t
64+
use prif_veggies, only: test_that, run_tests
6465

6566

6667

‎test/prif_veggies/prif_run_tests.f90

Lines changed: 181 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,181 @@
1+
module prif_run_tests
2+
use iso_c_binding, only: c_int64_t, c_size_t, c_ptr, c_null_ptr, c_null_funptr, c_f_pointer
3+
use iso_fortran_env, only: int64, output_unit, error_unit
4+
use iso_varying_string, only: put_line, var_str, operator(//)
5+
use prif, only: &
6+
prif_this_image_no_coarray, prif_num_images, &
7+
prif_critical_type, prif_coarray_handle, &
8+
prif_allocate_coarray, prif_deallocate_coarray, &
9+
prif_co_reduce, prif_operation_wrapper_interface
10+
use strff, only: to_string
11+
use veggies, only: filter_item_result_t, test_item_t, test_result_item_t
12+
use veggies_command_line_m, only: options_t, get_options, DEBUG
13+
14+
implicit none
15+
private
16+
public :: run_tests
17+
contains
18+
function run_tests(tests) result(passed)
19+
type(test_item_t), intent(in) :: tests
20+
logical :: passed
21+
22+
integer(int64) :: clock_rate
23+
real :: elapsed_time
24+
integer(int64) :: end_time
25+
type(filter_item_result_t) :: filtered_tests
26+
type(options_t) :: options
27+
type(test_result_item_t) :: results
28+
integer(int64) :: start_time
29+
logical :: suite_failed
30+
type(test_item_t) :: tests_to_run
31+
integer :: i, me, ni
32+
33+
suite_failed = .false.
34+
35+
options = get_options()
36+
37+
tests_to_run = tests
38+
do i = 1, size(options%filter_strings)
39+
filtered_tests = tests_to_run%filter(options%filter_strings(i))
40+
if (filtered_tests%matched()) then
41+
tests_to_run = filtered_tests%test()
42+
else
43+
call put_line(error_unit, "No matching tests found")
44+
passed = .false.
45+
return
46+
end if
47+
end do
48+
49+
call prif_this_image_no_coarray(this_image=me)
50+
call prif_num_images(ni)
51+
if (me == 1) then
52+
call put_line(output_unit, "Running Tests")
53+
call put_line(output_unit, "")
54+
55+
if (.not.options%quiet) then
56+
call put_line(output_unit, tests_to_run%description())
57+
call put_line(output_unit, "")
58+
end if
59+
60+
call put_line( &
61+
output_unit, &
62+
"A total of " // to_string(tests_to_run%num_cases()) // " test cases")
63+
call put_line(output_unit, "")
64+
end if
65+
66+
if (DEBUG) call put_line( &
67+
"Beginning execution of test suite" &
68+
// merge(" on image " // to_string(me), var_str(""), ni > 1))
69+
call system_clock(start_time, clock_rate)
70+
results = tests_to_run%run()
71+
call system_clock(end_time)
72+
if (DEBUG) call put_line( &
73+
"Completed execution of test suite." &
74+
// merge(" on image " // to_string(me), var_str(""), ni > 1))
75+
elapsed_time = real(end_time - start_time) / real(clock_rate)
76+
77+
block
78+
type(prif_critical_type) :: critical_mold
79+
type(prif_coarray_handle) :: critical_coarray
80+
type(c_ptr) :: allocated_memory
81+
82+
call prif_allocate_coarray( &
83+
lcobounds = [1_c_int64_t], &
84+
ucobounds = [int(ni, kind=c_int64_t)], &
85+
size_in_bytes = storage_size(critical_mold, kind=c_size_t), &
86+
final_func = c_null_funptr, &
87+
coarray_handle = critical_coarray, &
88+
allocated_memory = allocated_memory)
89+
call prif_critical(critical_coarray)
90+
if (ni > 1) then
91+
call put_line(output_unit, "On image " // to_string(me))
92+
end if
93+
if (results%passed()) then
94+
call put_line(output_unit, "All Passed")
95+
call put_line( &
96+
output_unit, &
97+
"Took " // to_string(elapsed_time, 6) // " seconds")
98+
call put_line(output_unit, "")
99+
if (options%verbose) then
100+
call put_line( &
101+
output_unit, &
102+
results%verbose_description(options%colorize))
103+
call put_line(output_unit, "")
104+
end if
105+
call put_line( &
106+
output_unit, &
107+
"A total of " // to_string(results%num_cases()) &
108+
// " test cases containing a total of " &
109+
// to_string(results%num_asserts()) // " assertions")
110+
call put_line(output_unit, "")
111+
else
112+
call put_line(error_unit, "Failed")
113+
call put_line( &
114+
error_unit, &
115+
"Took " // to_string(elapsed_time, 6) // " seconds")
116+
call put_line(error_unit, "")
117+
if (options%verbose) then
118+
call put_line( &
119+
error_unit, &
120+
results%verbose_description(options%colorize))
121+
else
122+
call put_line( &
123+
error_unit, &
124+
results%failure_description(options%colorize))
125+
end if
126+
call put_line(error_unit, "")
127+
call put_line( &
128+
error_unit, &
129+
to_string(results%num_failing_cases()) // " of " &
130+
// to_string(results%num_cases()) // " cases failed")
131+
call put_line( &
132+
error_unit, &
133+
to_string(results%num_failing_asserts()) // " of " &
134+
// to_string(results%num_asserts()) // " assertions failed")
135+
call put_line(error_unit, "")
136+
suite_failed = .true.
137+
end if
138+
139+
call prif_end_critical(critical_coarray)
140+
call prif_deallocate_coarray([critical_coarray])
141+
end block
142+
if (any_image_failed(suite_failed)) then
143+
passed = .false.
144+
else
145+
passed = .true.
146+
end if
147+
end function
148+
149+
function any_image_failed(image_failed)
150+
logical, intent(in) :: image_failed
151+
logical :: any_image_failed
152+
153+
any_image_failed = image_failed
154+
call co_any(any_image_failed)
155+
end function
156+
157+
subroutine co_any(x)
158+
logical, intent(inout) :: x
159+
160+
procedure(prif_operation_wrapper_interface), pointer :: op
161+
162+
op => or_wrapper
163+
call prif_co_reduce(x, op, c_null_ptr)
164+
end subroutine
165+
166+
subroutine or_wrapper(arg1, arg2_and_out, count, cdata) bind(C)
167+
type(c_ptr), intent(in), value :: arg1, arg2_and_out
168+
integer(c_size_t), intent(in), value :: count
169+
type(c_ptr), intent(in), value :: cdata
170+
171+
logical, pointer :: lhs(:), rhs_and_result(:)
172+
integer(c_size_t) :: i
173+
174+
if (count == 0) return
175+
call c_f_pointer(arg1, lhs, [count])
176+
call c_f_pointer(arg2_and_out, rhs_and_result, [count])
177+
do i = 1, count
178+
rhs_and_result(i) = lhs(i).or.rhs_and_result(i)
179+
end do
180+
end subroutine
181+
end module

‎test/prif_veggies/prif_simple_test_case_m.f90

Lines changed: 124 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,124 @@
1+
module prif_simple_test_case_m
2+
use forgex, only: operator(.in.)
3+
use iso_varying_string, only: &
4+
varying_string, operator(//), char, put_line, var_str
5+
use prif, only: prif_this_image_no_coarray, prif_num_images
6+
use strff, only: to_string
7+
use veggies_command_line_m, only: DEBUG
8+
use veggies_input_m, only: input_t
9+
use veggies_test_m, only: &
10+
filter_result_t, test_t, filter_failed, filter_matched
11+
use veggies_test_case_result_m, only: test_case_result_t
12+
use veggies_test_interfaces_m, only: computation_i, simple_test_i
13+
use veggies_test_result_item_m, only: test_result_item_t
14+
15+
implicit none
16+
private
17+
public :: simple_test_case_t
18+
19+
type, extends(test_t) :: simple_test_case_t
20+
private
21+
type(varying_string) :: description_
22+
procedure(simple_test_i), nopass, pointer :: test
23+
logical :: has_setup_and_teardown
24+
procedure(computation_i), nopass, pointer :: setup
25+
procedure(computation_i), nopass, pointer :: teardown
26+
contains
27+
private
28+
procedure, public :: description
29+
procedure, public :: filter
30+
procedure, public :: num_cases
31+
procedure, public :: run_with_input
32+
procedure, public :: run_without_input
33+
end type
34+
35+
interface simple_test_case_t
36+
module procedure constructor_basic
37+
module procedure constructor_bracketed
38+
end interface
39+
contains
40+
function constructor_basic(description, test) result(simple_test_case)
41+
type(varying_string), intent(in) :: description
42+
procedure(simple_test_i) :: test
43+
type(simple_test_case_t) :: simple_test_case
44+
45+
simple_test_case%description_ = description
46+
simple_test_case%test => test
47+
simple_test_case%has_setup_and_teardown = .false.
48+
end function
49+
50+
function constructor_bracketed( &
51+
description, test, setup, teardown) result(simple_test_case)
52+
type(varying_string), intent(in) :: description
53+
procedure(simple_test_i) :: test
54+
procedure(computation_i) :: setup
55+
procedure(computation_i) :: teardown
56+
type(simple_test_case_t) :: simple_test_case
57+
58+
simple_test_case%description_ = description
59+
simple_test_case%test => test
60+
simple_test_case%has_setup_and_teardown = .true.
61+
simple_test_case%setup => setup
62+
simple_test_case%teardown => teardown
63+
end function
64+
65+
pure function description(self)
66+
class(simple_test_case_t), intent(in) :: self
67+
type(varying_string) :: description
68+
69+
description = self%description_
70+
end function
71+
72+
function filter(self, filter_string) result(filter_result)
73+
class(simple_test_case_t), intent(in) :: self
74+
type(varying_string), intent(in) :: filter_string
75+
type(filter_result_t) :: filter_result
76+
77+
if (char(filter_string).in.char(self%description_)) then
78+
filter_result = filter_matched(self)
79+
else
80+
filter_result = filter_failed()
81+
end if
82+
end function
83+
84+
pure function num_cases(self)
85+
class(simple_test_case_t), intent(in) :: self
86+
integer :: num_cases
87+
88+
associate(unused => self)
89+
end associate
90+
91+
num_cases = 1
92+
end function
93+
94+
recursive function run_with_input(self, input) result(result_)
95+
class(simple_test_case_t), intent(in) :: self
96+
class(input_t), intent(in) :: input
97+
type(test_result_item_t) :: result_
98+
99+
associate(unused => input)
100+
end associate
101+
102+
result_ = self%run()
103+
end function
104+
105+
recursive function run_without_input(self) result(result_)
106+
class(prif_simple_test_case_t), intent(in) :: self
107+
type(test_result_item_t) :: result_
108+
109+
integer :: me, ni
110+
111+
call prif_this_image_no_coarray(this_image = me)
112+
call prif_num_images(ni)
113+
if (DEBUG) call put_line( &
114+
"Beginning execution of: " // self%description_&
115+
// merge(" on image " // to_string(me), var_str(""), ni > 1))
116+
if (self%has_setup_and_teardown) call self%setup
117+
result_ = test_result_item_t(test_case_result_t( &
118+
self%description_, self%test()))
119+
if (self%has_setup_and_teardown) call self%teardown
120+
if (DEBUG) call put_line( &
121+
"Completed execution of: " // self%description_&
122+
// merge(" on image " // to_string(me), var_str(""), ni > 1))
123+
end function
124+
end module

0 commit comments

Comments
 (0)