1! RUN: %S/test_errors.sh %s %t %flang_fc1
2! REQUIRES: shell
3! Initializer error tests
4
5subroutine objectpointers(j)
6  integer, intent(in) :: j
7  real, allocatable, target, save :: x1
8  real, codimension[*], target, save :: x2
9  real, save :: x3
10  real, target :: x4
11  real, target, save :: x5(10)
12!ERROR: An initial data target may not be a reference to an ALLOCATABLE 'x1'
13  real, pointer :: p1 => x1
14!ERROR: An initial data target may not be a reference to a coarray 'x2'
15  real, pointer :: p2 => x2
16!ERROR: An initial data target may not be a reference to an object 'x3' that lacks the TARGET attribute
17  real, pointer :: p3 => x3
18!ERROR: An initial data target may not be a reference to an object 'x4' that lacks the SAVE attribute
19  real, pointer :: p4 => x4
20!ERROR: An initial data target must be a designator with constant subscripts
21  real, pointer :: p5 => x5(j)
22!ERROR: Pointer has rank 0 but target has rank 1
23  real, pointer :: p6 => x5
24
25!TODO: type incompatibility, non-deferred type parameter values, contiguity
26
27end subroutine
28
29subroutine dataobjects(j)
30  integer, intent(in) :: j
31  real, parameter :: x1(*) = [1., 2.]
32!ERROR: Implied-shape parameter 'x2' has rank 2 but its initializer has rank 1
33  real, parameter :: x2(*,*) = [1., 2.]
34!ERROR: Named constant 'x3' array must have constant shape
35  real, parameter :: x3(j) = [1., 2.]
36!ERROR: Shape of initialized object 'x4' must be constant
37  real :: x4(j) = [1., 2.]
38!ERROR: Rank of initialized object is 2, but initialization expression has rank 1
39  real :: x5(2,2) = [1., 2., 3., 4.]
40  real :: x6(2,2) = 5.
41!ERROR: Rank of initialized object is 0, but initialization expression has rank 1
42  real :: x7 = [1.]
43  real :: x8(2,2) = reshape([1., 2., 3., 4.], [2, 2])
44!ERROR: Dimension 1 of initialized object has extent 3, but initialization expression has extent 2
45  real :: x9(3) = [1., 2.]
46!ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3
47  real :: x10(2,3) = reshape([real::(k,k=1,6)], [3, 2])
48end subroutine
49
50subroutine components
51  real, target, save :: a1(3)
52  real, target :: a2
53  real, save :: a3
54  real, target, save :: a4
55  type :: t1
56!ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3
57    real :: x1(2) = [1., 2., 3.]
58  end type
59  type :: t2(kind, len)
60    integer, kind :: kind
61    integer, len :: len
62!ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3
63!ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3
64    real :: x1(2) = [1., 2., 3.]
65!ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3
66    real :: x2(kind) = [1., 2., 3.]
67!ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3
68!ERROR: An automatic variable or component must not be initialized
69    real :: x3(len) = [1., 2., 3.]
70    real, pointer :: p1(:) => a1
71!ERROR: An initial data target may not be a reference to an object 'a2' that lacks the SAVE attribute
72!ERROR: An initial data target may not be a reference to an object 'a2' that lacks the SAVE attribute
73    real, pointer :: p2 => a2
74!ERROR: An initial data target may not be a reference to an object 'a3' that lacks the TARGET attribute
75!ERROR: An initial data target may not be a reference to an object 'a3' that lacks the TARGET attribute
76    real, pointer :: p3 => a3
77!ERROR: Pointer has rank 0 but target has rank 1
78!ERROR: Pointer has rank 0 but target has rank 1
79    real, pointer :: p4 => a1
80!ERROR: Pointer has rank 1 but target has rank 0
81!ERROR: Pointer has rank 1 but target has rank 0
82    real, pointer :: p5(:) => a4
83  end type
84  type(t2(3,3)) :: o1
85  type(t2(2,2)) :: o2
86  type :: t3
87    real :: x
88  end type
89  type(t3), save, target :: o3
90  real, pointer :: p10 => o3%x
91  associate (a1 => o3, a2 => o3%x)
92    block
93      real, pointer :: p11 => a1
94      real, pointer :: p12 => a2
95    end block
96  end associate
97end subroutine
98