1! Check for <var>%re, ...%im, ...%kind, ...%len
2! Cf. also OpenACC's ../goacc/ref_inquiry.f90
3! Cf. also OpenMP spec issue 2661
4implicit none
5type t
6  integer :: i
7  character :: c
8  complex :: z
9  complex :: zz(5)
10end type t
11
12integer :: i
13character(kind=4, len=5) :: c
14complex :: z, zz(5)
15type(t) :: x
16
17print *, is_contiguous(zz(:)%re)
18
19! inquiry function; expr_type != EXPR_VARIABLE:
20!$omp target enter data map(to: i%kind, c%len)     ! { dg-error "not a proper array section" }
21!$omp target enter data map(to: x%i%kind)          ! { dg-error "not a proper array section" }
22!$omp target enter data map(to: x%c%len)           ! { dg-error "not a proper array section" }
23
24! EXPR_VARIABLE
25!$omp target enter data map(to: z%re)    ! { dg-error "Unexpected complex-parts designator" }
26!$omp target enter data map(to: z%im)    ! { dg-error "Unexpected complex-parts designator" }
27!$omp target enter data map(to: zz%re)   ! { dg-error "not a proper array section" }
28!$omp target enter data map(to: zz%im)   ! { dg-error "not a proper array section" }
29
30!$omp target enter data map(to: x%z%re)  ! { dg-error "Unexpected complex-parts designator" }
31!$omp target enter data map(to: x%z%im)  ! { dg-error "Unexpected complex-parts designator" }
32!$omp target enter data map(to: x%zz%re) ! { dg-error "not a proper array section" }
33!$omp target enter data map(to: x%zz%im) ! { dg-error "not a proper array section" }
34
35end
36