Skip to content

Commit 95746fd

Browse files
zbeekmanzbeekman
authored
Merge branch 'master' into Travis-and-install-fixes
2 parents 5db475f + 74a53b7 commit 95746fd

File tree

3 files changed

+164
-24
lines changed

3 files changed

+164
-24
lines changed

‎CMakeLists.txt

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -673,11 +673,18 @@ if(opencoarrays_aware_compiler)
673673
if((NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.3.0) OR (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER}))
674674
add_caf_test(send_convert_char_array 2 send_convert_char_array)
675675
add_caf_test(alloc_comp_send_convert_nums 2 alloc_comp_send_convert_nums)
676-
else()#if((CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER}))
676+
elseif((NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.4.0) OR (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER}))
677+
add_caf_test(send-strided-self 2 send-strided-self)
678+
endif()
679+
if((CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.3.0) AND (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER}))
677680
message( AUTHOR_WARNING "Skipping the following tests to GFortran < 7.3.0 lack of compatibility:
678681
send_convert_char_array.f90
679682
alloc_comp_send_convert_nums.f90")
680683
endif()
684+
if((CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.4.0) AND (CAF_RUN_DEVELOPER_TESTS OR $ENV{OPENCOARRAYS_DEVELOPER}))
685+
message( AUTHOR_WARNING "Skipping the following test to GFortran < 7.4.0 lack of compatibility:
686+
send-strided-self.f90")
687+
endif()
681688
endif()
682689

683690
# Pure get tests

‎src/tests/unit/send-get/alloc_comp_send_convert_nums.f90

Lines changed: 0 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -381,18 +381,6 @@ program alloc_comp_send_convert_nums
381381
if (any(obj%int_k1 /= [INT(-2, 1), int_k1(4), INT(-2, 1), int_k1(5), INT(-2, 1)])) &
382382
& call print_and_register( 'send strided int kind=4 to kind=1 self failed')
383383

384-
obj%int_k1(1:5) = int_k1(5:1:-1)
385-
obj[1]%int_k1(::2) = obj%int_k1(3:1:-1)
386-
print *, obj%int_k1
387-
! Note, indezes two times reversed!
388-
if (any(obj%int_k1 /= [int_k1(3), int_k1(4), int_k1(4), int_k1(2), int_k1(5)])) &
389-
& call print_and_register( 'send strided with temp int kind=1 to kind=1 self failed')
390-
391-
! obj%int_k4(1:5) = int_k4(5:1:-1)
392-
! obj[1]%int_k4(::2) = obj%int_k4(3:1:-1)
393-
! print *, obj%int_k4
394-
! if (any(obj%int_k4 /= [int_k4(3), int_k4(4), int_k4(4), int_k4(2), int_k4(5)])) &
395-
! & call print_and_register( 'send strided with temp int kind=4 to kind=4 self failed')
396384
else if (me == 2) then ! Do the real copy to self checks on image 2
397385
obj%real_k4 = -1.0
398386
obj[2]%real_k4(::2) = real_k4(1:3)
@@ -418,17 +406,6 @@ program alloc_comp_send_convert_nums
418406
if (any(abs(obj%real_k4 - [-2.0, real_k4(1), -2.0, real_k4(2), -2.0]) > tolerance4)) &
419407
& call print_and_register( 'send strided real kind=8 to kind=4 self failed')
420408

421-
! obj%real_k4(1:5) = real_k4(5:1:-1)
422-
! obj[2]%real_k4(::2) = obj%real_k4(3:1:-1)
423-
! print *, obj%real_k4
424-
! if (any(abs(obj%real_k4 - [real_k4(3), real_k4(4), real_k4(4), real_k4(2), real_k4(5)]) > tolerance4)) &
425-
! & call print_and_register( 'send strided with temp real kind=4 to kind=4 self failed')
426-
!
427-
! obj%real_k8(1:5) = real_k8(5:1:-1)
428-
! obj[2]%real_k8(::2) = obj%real_k8(3:1:-1)
429-
! print *, obj%real_k8
430-
! if (any(abs(obj%real_k8 - [real_k8(3), real_k8(4), real_k8(4), real_k8(2), real_k8(5)]) > tolerance8)) &
431-
! & call print_and_register( 'send strided with temp real kind=8 to kind=8 self failed')
432409
end if
433410

434411
! Transfer to other image now.

‎src/tests/unit/send-get/send-strided-self.f90

Lines changed: 156 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,156 @@
1+
!! Thoroughly test send, i.e. foo[N].comp = bar in all variants
2+
!!
3+
!! Do simple tests for send(). These test comprise
4+
!!
5+
!! FOO[N].COMP = BAR
6+
!!
7+
!! where
8+
!!
9+
!! FOO BAR images
10+
!! scalar scalar N == me
11+
!! int(k e [1,4]) int(k e [1,4])
12+
!! real(k e [4,8]) real(k e [4,8])
13+
!! int(k e [1,4]) real(k e [4,8])
14+
!! real(k e [4,8]) int(k e [1,4])
15+
!!
16+
!! array(1:5) scalar
17+
!! int(k e [1,4]) int(k e [1,4])
18+
!! real(k e [4,8]) real(k e [4,8])
19+
!! int(k e [1,4]) real(k e [4,8])
20+
!! real(k e [4,8]) int(k e [1,4])
21+
!!
22+
!! array(1:5) array(1:5)
23+
!! int(k e [1,4]) int(k e [1,4])
24+
!! real(k e [4,8]) real(k e [4,8])
25+
!! int(k e [1,4]) real(k e [4,8])
26+
!! real(k e [4,8]) int(k e [1,4])
27+
!!
28+
!! array(1:3) array(::2)
29+
!! int(k e [1,4]) int(k e [1,4])
30+
!! real(k e [4,8]) real(k e [4,8])
31+
!! int(k e [1,4]) real(k e [4,8])
32+
!! real(k e [4,8]) int(k e [1,4])
33+
!!
34+
!! array(4:5) array(2::2)
35+
!! int(k e [1,4]) int(k e [1,4])
36+
!! real(k e [4,8]) real(k e [4,8])
37+
!! int(k e [1,4]) real(k e [4,8])
38+
!! real(k e [4,8]) int(k e [1,4])
39+
!!
40+
!! array(1:3) array(3:1:-1)
41+
!! int(k e [1,4]) int(k e [1,4])
42+
!! real(k e [4,8]) real(k e [4,8])
43+
!! int(k e [1,4]) real(k e [4,8])
44+
!! real(k e [4,8]) int(k e [1,4])
45+
!!
46+
!! all of the above but for N != me
47+
!!
48+
!! And may be some other, I've forgotten.
49+
!!
50+
!! Author: Andre Vehreschild, 2017
51+
52+
program alloc_comp_send_convert_nums
53+
use iso_fortran_env, only : int8,int32,real32,real64
54+
55+
implicit none
56+
57+
real(kind=real32), parameter :: tolerance4 = 1.0e-4_real32
58+
real(kind=real64), parameter :: tolerance4to8 = 1.0E-4_real64
59+
real(kind=real64), parameter :: tolerance8 = 1.0E-6_real64
60+
61+
type t
62+
integer(kind=int8), allocatable :: int_scal_k1
63+
integer(kind=int32), allocatable :: int_scal_k4
64+
real(kind=real32) , allocatable :: real_scal_k4
65+
real(kind=real64) , allocatable :: real_scal_k8
66+
integer(kind=int8), allocatable, dimension(:) :: int_k1
67+
integer(kind=int32), allocatable, dimension(:) :: int_k4
68+
real(kind=real32) , allocatable, dimension(:) :: real_k4
69+
real(kind=real64) , allocatable, dimension(:) :: real_k8
70+
end type t
71+
72+
integer(kind=int8) :: int_scal_k1
73+
integer(kind=int32) :: int_scal_k4
74+
real(kind=real32) :: real_scal_k4
75+
real(kind=real64) :: real_scal_k8
76+
77+
integer(kind=int8), dimension(1:5) :: int_k1
78+
integer(kind=int32), dimension(1:5) :: int_k4
79+
real(kind=real32) , dimension(1:5) :: real_k4
80+
real(kind=real64) , dimension(1:5) :: real_k8
81+
82+
type(t), save, codimension[*] :: obj
83+
84+
logical :: error_printed=.false.
85+
86+
associate(me => this_image(), np => num_images())
87+
if (np < 2) error stop 'Cannot run with less than 2 images.'
88+
89+
int_scal_k1 = INT(42, kind(int_scal_k1))
90+
int_scal_k4 = 42
91+
int_k1 = INT([5, 4, 3, 2, 1], kind(int_scal_k4))
92+
int_k4 = [5, 4, 3, 2, 1]
93+
allocate(obj%int_scal_k1, obj%int_scal_k4, obj%int_k1(5), obj%int_k4(5)) ! allocate syncs here
94+
95+
real_scal_k4 = 37.042
96+
real_scal_k8 = REAL(37.042, kind(real_scal_k8))
97+
real_k4 = [ 5.1, 4.2, 3.3, 2.4, 1.5]
98+
real_k8 = REAL([ 5.1, 4.2, 3.3, 2.4, 1.5], kind(real_k8))
99+
allocate(obj%real_scal_k4, obj%real_scal_k8, obj%real_k4(1:5), obj%real_k8(1:5)) ! allocate syncs here
100+
101+
! Now with strides
102+
! First check send/copy to self
103+
if (me == 1) then
104+
105+
obj%int_k1(1:5) = int_k1(5:1:-1)
106+
obj[1]%int_k1(::2) = obj%int_k1(3:1:-1)
107+
print *, obj%int_k1
108+
! Note, indezes two times reversed!
109+
if (any(obj%int_k1 /= [int_k1(3), int_k1(4), int_k1(4), int_k1(2), int_k1(5)])) &
110+
& call print_and_register( 'send strided with temp int kind=int8 to kind=1 self failed')
111+
112+
obj%int_k4(1:5) = int_k4(5:1:-1)
113+
obj[1]%int_k4(::2) = obj%int_k4(3:1:-1)
114+
print *, obj%int_k4
115+
if (any(obj%int_k4 /= [int_k4(3), int_k4(4), int_k4(4), int_k4(2), int_k4(5)])) &
116+
& call print_and_register( 'send strided with temp int kind=4 to kind=4 self failed')
117+
else if (me == 2) then ! Do the real copy to self checks on image 2
118+
119+
obj%real_k4(1:5) = real_k4(5:1:-1)
120+
obj[2]%real_k4(::2) = obj%real_k4(3:1:-1)
121+
print *, obj%real_k4
122+
if (any(abs(obj%real_k4 - [real_k4(3), real_k4(4), real_k4(4), real_k4(2), real_k4(5)]) > tolerance4)) &
123+
& call print_and_register( 'send strided with temp real kind=4 to kind=4 self failed')
124+
125+
obj%real_k8(1:5) = real_k8(5:1:-1)
126+
obj[2]%real_k8(::2) = obj%real_k8(3:1:-1)
127+
print *, obj%real_k8
128+
if (any(abs(obj%real_k8 - [real_k8(3), real_k8(4), real_k8(4), real_k8(2), real_k8(5)]) > tolerance8)) &
129+
& call print_and_register( 'send strided with temp real kind=real64 to kind=8 self failed')
130+
end if
131+
132+
select case(me)
133+
case(1)
134+
sync images(2) ! wait for image 2 to finish all checks
135+
if (error_printed) error stop
136+
sync images(2) ! wait for image 2 to get past its conditional error termination
137+
print *, "Test passed."
138+
case(2)
139+
sync images(1) ! wait for image 1 to finish all checks
140+
if (error_printed) error stop
141+
sync images(1)
142+
end select
143+
end associate
144+
145+
contains
146+
147+
subroutine print_and_register(error_message)
148+
use iso_fortran_env, only : error_unit
149+
character(len=*), intent(in) :: error_message
150+
write(error_unit,*) error_message
151+
error_printed=.true.
152+
end subroutine
153+
154+
end program alloc_comp_send_convert_nums
155+
156+
! vim:ts=2:sts=2:sw=2:

0 commit comments

Comments
 (0)