Skip to content

Commit 15d1446

Browse files
author
Damian Rouson
committed
Split apart alloc/non-alloc co_broadcast tests
1 parent 2c97277 commit 15d1446

File tree

4 files changed

+66
-46
lines changed

4 files changed

+66
-46
lines changed

CMakeLists.txt

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -798,6 +798,7 @@ if(opencoarrays_aware_compiler)
798798
add_caf_test(co_sum 4 co_sum_test)
799799
add_caf_test(co_broadcast 4 co_broadcast_test)
800800
add_caf_test(co_broadcast_derived_type 4 co_broadcast_derived_type_test)
801+
add_caf_test(co_broadcast_allocatable_components 4 co_broadcast_allocatable_components_test)
801802
add_caf_test(co_min 4 co_min_test)
802803
add_caf_test(co_max 4 co_max_test)
803804
add_caf_test(co_reduce 4 co_reduce_test)

src/tests/unit/collectives/CMakeLists.txt

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
caf_compile_executable(co_sum_test co_sum.F90)
22
caf_compile_executable(co_broadcast_test co_broadcast.F90)
33
caf_compile_executable(co_broadcast_derived_type_test co_broadcast_derived_type.f90)
4+
caf_compile_executable(co_broadcast_allocatable_components_test co_broadcast_allocatable_components.f90)
45
caf_compile_executable(co_min_test co_min.F90)
56
caf_compile_executable(co_max_test co_max.F90)
67
caf_compile_executable(co_reduce_test co_reduce.F90)
Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
program main
2+
!! author: Damian Rouson
3+
!!
4+
!! Test co_broadcast with derived-type actual arguments
5+
implicit none
6+
7+
integer, parameter :: sender=1 !! co_broadcast source_image
8+
character(len=*), parameter :: text="text" !! character message data
9+
10+
interface
11+
function f(x) result(y)
12+
real x, y
13+
end function
14+
end interface
15+
16+
type dynamic
17+
character(len=:), allocatable :: string
18+
character(len=len(text)), allocatable :: string_array(:)
19+
complex, allocatable :: scalar
20+
integer, allocatable :: vector(:)
21+
logical, allocatable :: matrix(:,:)
22+
real, allocatable :: superstring(:,:,:, :,:,:, :,:,:, :,:,:, :,:,: )
23+
end type
24+
25+
type(dynamic) alloc_message, alloc_content
26+
27+
associate(me=>this_image())
28+
29+
alloc_content = dynamic( &
30+
string=text, &
31+
string_array=[text], &
32+
scalar=(0.,1.), &
33+
vector=reshape( [integer::], [0]), &
34+
matrix=reshape( [.true.], [1,1]), &
35+
superstring=reshape([1,2,3,4], [2,1,2, 1,1,1, 1,1,1, 1,1,1, 1,1,1 ]) &
36+
)
37+
38+
if (me==sender) alloc_message = alloc_content
39+
40+
call co_broadcast(alloc_message,source_image=sender)
41+
42+
associate( failures => [ &
43+
alloc_message%string /= alloc_content%string, &
44+
alloc_message%string_array /= alloc_content%string_array, &
45+
alloc_message%scalar /= alloc_content%scalar, &
46+
alloc_message%vector /= alloc_content%vector, &
47+
alloc_message%matrix .neqv. alloc_content%matrix, &
48+
alloc_message%superstring /= alloc_content%superstring &
49+
] )
50+
51+
if ( any(failures) ) error stop "Test failed."
52+
53+
end associate
54+
55+
sync all ! Wait for each image to pass the test
56+
if (me==sender) print *,"Test passed."
57+
58+
end associate
59+
60+
end program main

src/tests/unit/collectives/co_broadcast_derived_type.f90

Lines changed: 4 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -13,9 +13,6 @@ function f(x) result(y)
1313
end function
1414
end interface
1515

16-
associate(me=>this_image())
17-
18-
test_non_allocatable: block
1916
type parent
2017
integer :: heritable=0
2118
end type
@@ -52,6 +49,9 @@ function f(x) result(y)
5249
a=component(-3), b=reshape([component(-2),component(-1)], [1,2,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1]), & ! derived types
5350
c=text, z=[character(len=len(text))::], i=(0.,1.), j=(2.,3.), k=4, l=5, r=.true., s=.true., t=7., u=8. & ! intrinsic types
5451
)
52+
53+
associate(me=>this_image())
54+
5555
if (me==sender) then
5656
message = content
5757
allocate(message%char_ptr, message%char_ptr_maxdim(1,1,2, 1,1,1, 1,1,1, 1,1,1, 1,1,1), source=text )
@@ -87,52 +87,10 @@ function f(x) result(y)
8787
any( message%u /= content%u ) &
8888
] )
8989

90-
if ( any(failures) ) error stop "Test failed in non-allocatable block."
91-
92-
end associate
93-
94-
end block test_non_allocatable
95-
96-
test_allocatable: block
97-
type dynamic
98-
character(len=:), allocatable :: string
99-
character(len=len(text)), allocatable :: string_array(:)
100-
complex, allocatable :: scalar
101-
integer, allocatable :: vector(:)
102-
logical, allocatable :: matrix(:,:)
103-
real, allocatable :: superstring(:,:,:, :,:,:, :,:,:, :,:,:, :,:,: )
104-
end type
105-
106-
type(dynamic) alloc_message, alloc_content
107-
108-
alloc_content = dynamic( &
109-
string=text, &
110-
string_array=[text], &
111-
scalar=(0.,1.), &
112-
vector=reshape( [integer::], [0]), &
113-
matrix=reshape( [.true.], [1,1]), &
114-
superstring=reshape([1,2,3,4], [2,1,2, 1,1,1, 1,1,1, 1,1,1, 1,1,1 ]) &
115-
)
116-
117-
if (me==sender) alloc_message = alloc_content
118-
119-
call co_broadcast(alloc_message,source_image=sender)
120-
121-
associate( failures => [ &
122-
alloc_message%string /= alloc_content%string, &
123-
alloc_message%string_array /= alloc_content%string_array, &
124-
alloc_message%scalar /= alloc_content%scalar, &
125-
alloc_message%vector /= alloc_content%vector, &
126-
alloc_message%matrix .neqv. alloc_content%matrix, &
127-
alloc_message%superstring /= alloc_content%superstring &
128-
] )
129-
130-
if ( any(failures) ) error stop "Test failed in allocatable block."
90+
if ( any(failures) ) error stop "Test failed. "
13191

13292
end associate
13393

134-
end block test_allocatable
135-
13694
sync all ! Wait for each image to pass the test
13795
if (me==sender) print *,"Test passed."
13896

0 commit comments

Comments
 (0)