1! { dg-do compile }
2! { dg-options "-fcoarray=single" }
3!
4! PR fortran/50420
5! Coarray subobjects were not accepted as valid coarrays
6! They should still be rejected if one of the component reference is allocatable
7! or pointer
8
9type t
10  integer :: i
11end type t
12type t2
13  type(t), allocatable :: a
14  type(t), pointer     :: c
15end type t2
16type(t2) :: b[5:*]
17allocate(b%a)
18allocate(b%c)
19b%a%i = 7
20b%c%i = 13
21if (b%a%i /= 7) STOP 1
22if (any (lcobound(b%a) /= (/ 5 /))) STOP 2! { dg-error "Expected coarray variable" }
23if (ucobound(b%a, dim=1) /= this_image() + 4) STOP 3! { dg-error "Expected coarray variable" }
24if (any (lcobound(b%a%i) /= (/ 5 /))) STOP 4! { dg-error "Expected coarray variable" }
25if (ucobound(b%a%i, dim=1) /= this_image() + 4) STOP 5! { dg-error "Expected coarray variable" }
26if (b%c%i /= 13) STOP 6
27if (any (lcobound(b%c) /= (/ 5 /))) STOP 7! { dg-error "Expected coarray variable" }
28if (ucobound(b%c, dim=1) /= this_image() + 4) STOP 8! { dg-error "Expected coarray variable" }
29if (any (lcobound(b%c%i) /= (/ 5 /))) STOP 9! { dg-error "Expected coarray variable" }
30if (ucobound(b%c%i, dim=1) /= this_image() + 4) STOP 10! { dg-error "Expected coarray variable" }
31end
32