Skip to content

Commit 24f43b4

Browse files
author
Damian Rouson
authored
Merge pull request #6 from sourceryinstitute/unit-test
Unit tests: add `findloc` tests
2 parents cb1f0cf + 45bf713 commit 24f43b4

File tree

8 files changed

+216
-38
lines changed

8 files changed

+216
-38
lines changed

‎.github/workflows/CI.yml‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,4 +33,10 @@ jobs:
3333
- name: Build and Test
3434
run: |
3535
export PATH="${HOME}/.local/bin:$PATH"
36-
fpm test --compiler caf --runner "cafrun -n 4"
36+
fpm test \
37+
--compiler caf \
38+
--runner "cafrun -n 4" \
39+
--flag "-DCOMPILER_LACKS_COLLECTIVE_SUBROUTINES" \
40+
--flag "-DCOMPILER_LACKS_FINDLOC" \
41+
--flag "-Wall" \
42+
--flag "-std=f2018"

‎fpm.toml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ maintainer = "[email protected]"
66
copyright = "2020 Sourcery Institute"
77

88
[dev-dependencies]
9-
vegetables = {git = "https://gitlab.com/everythingfunctional/vegetables", tag = "v5.1.1"}
9+
vegetables = {git = "https://gitlab.com/everythingfunctional/vegetables", tag = "v6.0.0"}
1010

1111
[[test]]
1212
name="unit"

‎src/emulated_intrinsics_implementation.F90‎

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,14 @@
1010

1111
contains
1212

13-
module procedure dummy
13+
module procedure co_all
14+
call co_reduce(boolean, both)
15+
contains
16+
pure function both(lhs,rhs) result(lhs_and_rhs)
17+
logical, intent(in) :: lhs,rhs
18+
logical lhs_and_rhs
19+
lhs_and_rhs = lhs .and. rhs
20+
end function
1421
end procedure
1522

1623
#ifdef COMPILER_LACKS_COLLECTIVE_SUBROUTINES

‎src/emulated_intrinsics_interface.F90‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,8 +12,9 @@ module emulated_intrinsics_interface
1212
implicit none
1313

1414
interface
15-
module subroutine dummy
16-
!! ensure a non-empty module
15+
module subroutine co_all(boolean)
16+
implicit none
17+
logical, intent(inout) :: boolean
1718
end subroutine
1819
end interface
1920

‎tests/collective_subroutines_test.f90‎

Lines changed: 85 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,85 @@
1+
module collective_subroutines_test
2+
use Vegetables, only: Result_t, Test_Item_t, describe, it, succeed, assert_equals, assert_that, assert_not
3+
use emulated_intrinsics_interface, only : co_sum, co_all
4+
5+
implicit none
6+
private
7+
8+
public :: test_co_sum, test_co_all
9+
contains
10+
function test_co_sum() result(tests)
11+
type(Test_Item_t) :: tests
12+
13+
tests = describe( &
14+
"co_sum", &
15+
[it( &
16+
"gives sums with result_image present", &
17+
check_co_sum_with_result_image), &
18+
it( &
19+
"gives sums without result_image present", &
20+
check_co_sum_without_result_image)])
21+
end function
22+
23+
function test_co_all() result(tests)
24+
type(Test_Item_t) :: tests
25+
26+
tests = describe( &
27+
"co_all", &
28+
[it( &
29+
"sets all arguments to .true. when previously .true. on all images", &
30+
check_co_all_with_all_true), &
31+
it( &
32+
"sets all arguments to .false. when previously .false. on image 1", &
33+
check_co_all_with_one_false)])
34+
end function
35+
36+
function check_co_sum_with_result_image() result(result_)
37+
type(Result_t) :: result_
38+
39+
integer i, j
40+
integer, parameter :: result_image=2
41+
42+
associate(me => this_image())
43+
i = me
44+
call co_sum(i, result_image)
45+
if (me==result_image) then
46+
result_ = assert_equals(sum([(j, j=1, num_images())]), i, "collective sum on result_image")
47+
else
48+
result_ = assert_equals(me, i, "co_sum argument unchanged on non-result_image")
49+
end if
50+
end associate
51+
end function
52+
53+
function check_co_sum_without_result_image() result(result_)
54+
type(Result_t) :: result_
55+
56+
integer i, j
57+
integer, parameter :: result_image=2
58+
59+
associate(me => this_image())
60+
i = me
61+
call co_sum(i)
62+
result_ = assert_equals(sum([(j, j=1, num_images())]), i, "co_sum without result_image present")
63+
end associate
64+
end function
65+
66+
function check_co_all_with_all_true() result(result_)
67+
type(Result_t) :: result_
68+
logical all_true
69+
70+
all_true=.true.
71+
72+
call co_all(all_true)
73+
result_ = assert_that(all_true, "co_all argument remains .true. after call with all arguments true")
74+
end function
75+
76+
function check_co_all_with_one_false() result(result_)
77+
type(Result_t) :: result_
78+
logical all_true
79+
80+
all_true = merge(.false., .true., this_image()==1)
81+
call co_all(all_true)
82+
result_ = assert_not(all_true, "co_all argument is .false. after call with one argument false")
83+
end function
84+
85+
end module

‎tests/example_test.f90‎

Lines changed: 0 additions & 24 deletions
This file was deleted.

‎tests/main.f90‎

Lines changed: 16 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,25 @@
1+
! Generated by make_vegetable_driver. DO NOT EDIT
12
program main
2-
use example_test, only : test_example
3-
use Vegetables_m, only: TestItem_t, testThat, runTests
4-
53
implicit none
64

75
call run()
86
contains
97
subroutine run()
10-
type(TestItem_t) :: tests
11-
type(TestItem_t) :: individual_tests(1)
8+
use collective_subroutines_test, only: &
9+
collective_subroutines_co_sum => test_co_sum, &
10+
collective_subroutines_co_all => test_co_all
11+
use single_image_intrinsics_test, only: &
12+
single_image_intrinsics_findloc => test_findloc
13+
use vegetables, only: test_item_t, test_that, run_tests
14+
15+
type(test_item_t) :: tests
16+
type(test_item_t) :: individual_tests(3)
1217

13-
individual_tests(1) = test_example()
14-
tests = testThat(individual_tests)
18+
individual_tests(1) = collective_subroutines_co_sum()
19+
individual_tests(2) = collective_subroutines_co_all()
20+
individual_tests(3) = single_image_intrinsics_findloc()
21+
tests = test_that(individual_tests)
1522

16-
call runTests(tests)
17-
end subroutine run
23+
call run_tests(tests)
24+
end subroutine
1825
end program

‎tests/single_image_intrinsics_test.f90‎

Lines changed: 96 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,96 @@
1+
!
2+
! (c) 2019-2020 Guide Star Engineering, LLC
3+
! This Software was developed for the US Nuclear Regulatory Commission (US NRC) under contract
4+
! "Multi-Dimensional Physics Implementation into Fuel Analysis under Steady-state and Transients (FAST)",
5+
! contract # NRC-HQ-60-17-C-0007
6+
!
7+
module single_image_intrinsics_test
8+
use Vegetables, only: Result_t, Test_Item_t, describe, it, assert_equals
9+
use emulated_intrinsics_interface, only : findloc
10+
11+
implicit none
12+
private
13+
public :: test_findloc
14+
15+
contains
16+
17+
function test_findloc() result(tests)
18+
type(Test_Item_t) :: tests
19+
20+
tests = describe( &
21+
"findloc", &
22+
[it( &
23+
"handles zero-sized argument", &
24+
check_zero_sized_argument), &
25+
it( &
26+
"handles absent back argument", &
27+
check_absent_back), &
28+
it( &
29+
"handles .false. back argument", &
30+
check_false_back), &
31+
it( &
32+
"handles .true. back argument", &
33+
check_true_back), &
34+
it( &
35+
"handles absent back argument", &
36+
check_logical_argument), &
37+
it( &
38+
"handles character array argument", &
39+
check_character_array), &
40+
it( &
41+
"handles empty character array argument", &
42+
check_empty_character_array), &
43+
it( &
44+
"handles failed search", &
45+
check_nonexistent_character_value)])
46+
end function
47+
48+
function check_zero_sized_argument() result(result_)
49+
type(Result_t) :: result_
50+
integer, parameter :: zero_sized_array(*) = [ integer :: ]
51+
result_ = assert_equals(0, findloc(zero_sized_array, value=99, dim=1, back=.true.), "findloc handles zero-sized array")
52+
end function
53+
54+
function check_absent_back() result(result_)
55+
type(Result_t) :: result_
56+
result_ = assert_equals(3, findloc([1,2,3,4], value=3, dim=1), "findloc handles absent 'back' argument")
57+
end function
58+
59+
function check_false_back() result(result_)
60+
type(Result_t) :: result_
61+
result_ = assert_equals(2, findloc([1,2,3,4], value=2, dim=1, back=.false.), "findloc handles .false. 'back' argument")
62+
end function
63+
64+
function check_true_back() result(result_)
65+
type(Result_t) :: result_
66+
result_ = assert_equals(1, findloc([1,2,3,4], value=1, dim=1, back=.true.), "findloc handles .true. 'back' argument")
67+
end function
68+
69+
function check_logical_argument() result(result_)
70+
type(Result_t) :: result_
71+
logical, parameter :: first_true(*) = [.true., .false., .false.]
72+
result_ = assert_equals(1, findloc(first_true, value=.true., dim=1, back=.true.), "findloc handles logical argument")
73+
end function
74+
75+
function check_character_array() result(result_)
76+
type(Result_t) :: result_
77+
character(len=*), parameter, dimension(*) :: rgb = ["roy", "gee", "biv"]
78+
result_ = assert_equals(2, findloc(rgb, value="gee", dim=1), "findloc finds string location")
79+
end function
80+
81+
function check_empty_character_array() result(result_)
82+
type(Result_t) :: result_
83+
character(len=*), parameter, dimension(*) :: empty = [character(len=len("hello"))::]
84+
result_ = &
85+
assert_equals(0, findloc(empty, value="hello", dim=1, back=.false.), "findloc handles empty character array from front")
86+
end function
87+
88+
function check_nonexistent_character_value() result(result_)
89+
type(Result_t) :: result_
90+
character(len=*), parameter, dimension(*) :: unsuccessful = ["foo", "bar", "too"]
91+
result_ = assert_equals(0, &
92+
findloc(unsuccessful, value="foobar", dim=1, back=.false.), "findloc handles character array without search target")
93+
end function
94+
95+
end module
96+

0 commit comments

Comments
 (0)