|
| 1 | +program co_broadcast_derived_with_allocs_test |
| 2 | +!! author: Brad Richardson & Andre Vehreschild |
| 3 | +!! category: regression |
| 4 | +!! |
| 5 | +!! [issue #727](https://github.com/sourceryinstitute/opencoarrays/issues/727) |
| 6 | +!! broadcasting derived types with a mixture of scalar and allocatable |
| 7 | +!! scalars or arrays lead to unexpected results |
| 8 | + |
| 9 | +implicit none |
| 10 | + |
| 11 | +type nsas_t |
| 12 | + integer :: i |
| 13 | + integer, allocatable :: j |
| 14 | +end type |
| 15 | + |
| 16 | +type asas_t |
| 17 | + integer, allocatable :: i |
| 18 | + integer, allocatable :: j |
| 19 | +end type |
| 20 | + |
| 21 | +type nsaa_t |
| 22 | + integer :: i |
| 23 | + integer, allocatable :: j(:) |
| 24 | +end type |
| 25 | + |
| 26 | +type naaa_t |
| 27 | + integer :: i(3) |
| 28 | + integer, allocatable :: j(:) |
| 29 | +end type |
| 30 | + |
| 31 | +type(nsas_t) nsas |
| 32 | +type(asas_t) asas |
| 33 | +type(nsaa_t) nsaa |
| 34 | +type(naaa_t) naaa |
| 35 | + |
| 36 | +integer, parameter :: source_image = 1 |
| 37 | + |
| 38 | +if (this_image() == source_image) then |
| 39 | + nsas = nsas_t(2, 3) |
| 40 | + |
| 41 | + asas = asas_t(4, 5) |
| 42 | + |
| 43 | + nsaa = nsaa_t(6, (/ 7, 8 /)) |
| 44 | + |
| 45 | + naaa = naaa_t((/ 9,10,11 /), (/ 12,13,14,15 /)) |
| 46 | +else |
| 47 | + allocate(nsas%j) |
| 48 | + |
| 49 | + allocate(asas%i); allocate(asas%j) |
| 50 | + |
| 51 | + allocate(nsaa%j(2)) |
| 52 | + |
| 53 | + allocate(naaa%j(4)) |
| 54 | +end if |
| 55 | + |
| 56 | +print *, "nsas" |
| 57 | +call co_broadcast(nsas, source_image) |
| 58 | +if (nsas%i /= 2 .or. nsas%j /= 3) error stop "Test failed at 1." |
| 59 | + |
| 60 | +print *, "asas" |
| 61 | +call co_broadcast(asas, source_image) |
| 62 | +if (asas%i /= 4 .or. asas%j /= 5) error stop "Test failed at 2." |
| 63 | + |
| 64 | +print *, "nsaa" |
| 65 | +call co_broadcast(nsaa, source_image) |
| 66 | +if (nsaa%i /= 6 .or. any(nsaa%j(:) /= (/ 7, 8 /))) error stop "Test failed at 3." |
| 67 | + |
| 68 | +print *, "naaa" |
| 69 | +call co_broadcast(naaa, source_image) |
| 70 | +if (any(naaa%i(:) /= (/ 9,10,11 /)) .or. any(naaa%j(:) /= (/ 12,13,14,15 /))) then |
| 71 | + error stop "Test failed at 3." |
| 72 | +end if |
| 73 | + |
| 74 | +sync all |
| 75 | + |
| 76 | +print *, "Test passed." |
| 77 | + |
| 78 | +end |
0 commit comments