xref: /llvm-project/flang/test/Semantics/select-rank03.f90 (revision 9ab292d72651c6dda098a653320f7fbb3624b778)
1! RUN: %python %S/test_errors.py %s %flang_fc1
2program test
3  real, allocatable :: a0, a1(:)
4  real, pointer :: p0, p1(:)
5  real, target :: t0, t1(1)
6 contains
7  subroutine allocatables(a)
8    real, allocatable :: a(..)
9    select rank(a)
10    rank (0)
11      allocate(a) ! ok
12      deallocate(a) ! ok
13      allocate(a, source=a0) ! ok
14      allocate(a, mold=p0) ! ok
15      a = 1. ! ok
16      !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches scalar REAL(4) and rank 1 array of REAL(4)
17      a = [1.]
18      !ERROR: If SOURCE appears, the related expression must be scalar or have the same rank as each allocatable object in ALLOCATE
19      allocate(a, source=a1)
20      allocate(a, mold=p1) ! ok, mold= ignored
21    rank (1)
22      allocate(a(1)) ! ok
23      deallocate(a) ! ok
24      a = 1. ! ok
25      a = [1.] ! ok
26      !ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
27      allocate(a, source=a0)
28      !ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
29      allocate(a, mold=p0)
30      allocate(a, source=a1) ! ok
31      allocate(a, mold=p1) ! ok
32    rank (2)
33      allocate(a(1,1)) ! ok
34      deallocate(a) ! ok
35      a = 1. ! ok
36      !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches rank 2 array of REAL(4) and rank 1 array of REAL(4)
37      a = [1.]
38      !ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
39      allocate(a, source=a0)
40      !ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
41      allocate(a, mold=p0)
42      !ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
43      allocate(a, source=a1)
44      !ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
45      allocate(a, mold=p1)
46    !ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
47    rank (*)
48      !ERROR: Whole assumed-size array 'a' may not appear here without subscripts
49      allocate(a)
50      !ERROR: Whole assumed-size array 'a' may not appear here without subscripts
51      deallocate(a)
52      !ERROR: Whole assumed-size array 'a' may not appear here without subscripts
53      a = 1.
54    rank default
55      !ERROR: An assumed-rank dummy argument may not appear in an ALLOCATE statement
56      allocate(a)
57      deallocate(a)
58      !ERROR: An assumed-rank dummy argument is not allowed in an assignment statement
59      !ERROR: An assumed-rank dummy argument is not allowed as an operand here
60      a = a + 1.
61    end select
62    ! Test nested associations
63    select rank(a)
64    rank default
65      select rank(a)
66      rank default
67        select rank(a)
68        rank (0)
69          allocate(a) ! ok
70          deallocate(a) ! ok
71        rank (1)
72          allocate(a(1)) ! ok
73          deallocate(a) ! ok
74        end select
75      end select
76    end select
77  end
78  subroutine pointers(p)
79    real, pointer :: p(..)
80    select rank(p)
81    rank (0)
82      allocate(p) ! ok
83      deallocate(p) ! ok
84      allocate(p, source=a0) ! ok
85      allocate(p, mold=p0) ! ok
86      !ERROR: If SOURCE appears, the related expression must be scalar or have the same rank as each allocatable object in ALLOCATE
87      allocate(p, source=a1)
88      allocate(p, mold=p1) ! ok, mold ignored
89      p => t0 ! ok
90      !ERROR: Pointer has rank 0 but target has rank 1
91      p => t1
92    rank (1)
93      allocate(p(1)) ! ok
94      deallocate(p) ! ok
95      !ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
96      allocate(p, source=a0)
97      !ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
98      allocate(p, mold=p0)
99      allocate(p, source=a1) ! ok
100      allocate(p, mold=p1) ! ok
101      !ERROR: Pointer has rank 1 but target has rank 0
102      p => t0
103      p => t1 ! ok
104    rank (2)
105      allocate(p(1,1)) ! ok
106      deallocate(p) ! ok
107      !ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
108      allocate(p, source=a0)
109      !ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
110      allocate(p, mold=p0)
111      !ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
112      allocate(p, source=a1)
113      !ERROR: Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD
114      allocate(p, mold=p1)
115      !ERROR: Pointer has rank 2 but target has rank 0
116      p => t0
117      !ERROR: Pointer has rank 2 but target has rank 1
118      p => t1
119    !ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
120    rank (*)
121      !ERROR: Whole assumed-size array 'p' may not appear here without subscripts
122      allocate(p)
123      !ERROR: Whole assumed-size array 'p' may not appear here without subscripts
124      deallocate(p)
125    rank default
126      !ERROR: An assumed-rank dummy argument may not appear in an ALLOCATE statement
127      allocate(p)
128      deallocate(p)
129      !ERROR: The left-hand side of a pointer assignment must not be an assumed-rank dummy argument
130      !ERROR: pointer 'p' associated with object 't0' with incompatible type or shape
131      p => t0
132      !ERROR: The left-hand side of a pointer assignment must not be an assumed-rank dummy argument
133      !ERROR: pointer 'p' associated with object 't1' with incompatible type or shape
134      p => t1
135    end select
136  end
137  subroutine undefinable(p)
138    real, pointer, intent(in) :: p(..)
139    real, target :: t
140    select rank(p)
141    rank (0)
142      !ERROR: The left-hand side of a pointer assignment is not definable
143      !BECAUSE: 'p' is an INTENT(IN) dummy argument
144      p => t
145      !ERROR: Name in DEALLOCATE statement is not definable
146      !BECAUSE: 'p' is an INTENT(IN) dummy argument
147      deallocate(p)
148    !ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
149    rank (*)
150      !ERROR: Whole assumed-size array 'p' may not appear here without subscripts
151      !ERROR: Name in DEALLOCATE statement is not definable
152      !BECAUSE: 'p' is an INTENT(IN) dummy argument
153      deallocate(p)
154    rank default
155      !ERROR: Name in DEALLOCATE statement is not definable
156      !BECAUSE: 'p' is an INTENT(IN) dummy argument
157      deallocate(p)
158    end select
159  end
160end
161