File tree Expand file tree Collapse file tree 3 files changed +40
-0
lines changed
src/tests/regression/reported Expand file tree Collapse file tree 3 files changed +40
-0
lines changed Original file line number Diff line number Diff line change @@ -887,6 +887,8 @@ if(opencoarrays_aware_compiler)
887
887
add_caf_test (issue-515-mimic-mpi-gatherv 2 issue-515-mimic-mpi-gatherv )
888
888
endif ()
889
889
890
+ add_caf_test (issue-700-allow-multiple-scalar-dim-array-gets 2 issue-700-allow-multiple-scalar-dim-array-gets )
891
+
890
892
# IMAGE FAIL tests
891
893
if (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0 )
892
894
if (CAF_ENABLE_FAILED_IMAGES )
Original file line number Diff line number Diff line change @@ -12,6 +12,7 @@ caf_compile_executable(issue-503-non-contig-red-ndarray issue-503-non-contig-red
12
12
caf_compile_executable (issue-322-non-coarray-vector-idx-lhs issue-322-non-coarray-vector-idx-lhs.f90 )
13
13
caf_compile_executable (issue-552-send_by_ref-singleton issue-552-send_by_ref-singleton.f90 )
14
14
caf_compile_executable (issue-511-incorrect-shape issue-511-incorrect-shape.f90 )
15
+ caf_compile_executable (issue-700-allow-multiple-scalar-dim-array-gets issue-700-allow-multiple-scalar-dim-array-gets.f90 )
15
16
if (gfortran_compiler AND (NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 7.0.0 ))
16
17
caf_compile_executable (issue-515-mimic-mpi-gatherv issue-515-mimic-mpi-gatherv.f90 )
17
18
endif ()
Original file line number Diff line number Diff line change
1
+ implicit none
2
+
3
+ type package
4
+ integer , allocatable :: surface_fluxes(:)
5
+ end type
6
+
7
+ type outbox
8
+ type (package), allocatable :: block_surfaces(:)
9
+ end type
10
+
11
+ type (outbox), save :: halo[* ]
12
+
13
+ integer , parameter :: source_image = 1
14
+ integer , parameter :: message(1 )= [99 ]
15
+
16
+ associate (me = > this_image())
17
+ if (me == source_image) then
18
+ allocate (halo% block_surfaces(1 ))
19
+ allocate (halo% block_surfaces(1 )% surface_fluxes, source = message)
20
+ end if
21
+
22
+ sync all
23
+
24
+ if (me /= source_image) then
25
+ allocate (halo% block_surfaces(1 ))
26
+ allocate (halo% block_surfaces(1 )% surface_fluxes, mold = halo[source_image]% block_surfaces(1 )% surface_fluxes)
27
+ halo% block_surfaces(1 )% surface_fluxes(1 ) = halo[source_image]% block_surfaces(1 )% surface_fluxes(1 )
28
+
29
+ if (me == source_image + 1 ) then
30
+ if (halo% block_surfaces(1 )% surface_fluxes(1 ) == 99 ) then
31
+ write (* ,* ) ' Test passed.'
32
+ end if
33
+ end if
34
+ end if
35
+
36
+ end associate
37
+ end
You can’t perform that action at this time.
0 commit comments