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