|
173
|
1 ! RUN: %S/test_errors.sh %s %t %f18
|
|
|
2 ! Pointer assignment constraints 10.2.2.2 (see also assign02.f90)
|
|
|
3
|
|
|
4 module m
|
|
|
5 interface
|
|
|
6 subroutine s(i)
|
|
|
7 integer i
|
|
|
8 end
|
|
|
9 end interface
|
|
|
10 type :: t
|
|
|
11 procedure(s), pointer, nopass :: p
|
|
|
12 real, pointer :: q
|
|
|
13 end type
|
|
|
14 contains
|
|
|
15 ! C1027
|
|
|
16 subroutine s1
|
|
|
17 type(t), allocatable :: a(:)
|
|
|
18 type(t), allocatable :: b[:]
|
|
|
19 a(1)%p => s
|
|
|
20 !ERROR: Procedure pointer may not be a coindexed object
|
|
|
21 b[1]%p => s
|
|
|
22 end
|
|
|
23 ! C1028
|
|
|
24 subroutine s2
|
|
|
25 type(t) :: a
|
|
|
26 a%p => s
|
|
|
27 !ERROR: In assignment to object pointer 'q', the target 's' is a procedure designator
|
|
|
28 a%q => s
|
|
|
29 end
|
|
|
30 ! C1029
|
|
|
31 subroutine s3
|
|
|
32 type(t) :: a
|
|
|
33 a%p => f() ! OK: pointer-valued function
|
|
|
34 !ERROR: Subroutine pointer 'p' may not be associated with function designator 'f'
|
|
|
35 a%p => f
|
|
|
36 contains
|
|
|
37 function f()
|
|
|
38 procedure(s), pointer :: f
|
|
|
39 f => s
|
|
|
40 end
|
|
|
41 end
|
|
|
42
|
|
|
43 ! C1030 and 10.2.2.4 - procedure names as target of procedure pointer
|
|
|
44 subroutine s4(s_dummy)
|
|
|
45 procedure(s), intent(in) :: s_dummy
|
|
|
46 procedure(s), pointer :: p, q
|
|
|
47 procedure(), pointer :: r
|
|
|
48 integer :: i
|
|
|
49 external :: s_external
|
|
|
50 p => s_dummy
|
|
|
51 p => s_internal
|
|
|
52 p => s_module
|
|
|
53 q => p
|
|
|
54 r => s_external
|
|
|
55 contains
|
|
|
56 subroutine s_internal(i)
|
|
|
57 integer i
|
|
|
58 end
|
|
|
59 end
|
|
|
60 subroutine s_module(i)
|
|
|
61 integer i
|
|
|
62 end
|
|
|
63
|
|
|
64 ! 10.2.2.4(3)
|
|
|
65 subroutine s5
|
|
|
66 procedure(f_pure), pointer :: p_pure
|
|
|
67 procedure(f_impure), pointer :: p_impure
|
|
|
68 !ERROR: Procedure pointer 'p_elemental' may not be ELEMENTAL
|
|
|
69 procedure(f_elemental), pointer :: p_elemental
|
|
|
70 p_pure => f_pure
|
|
|
71 p_impure => f_impure
|
|
|
72 p_impure => f_pure
|
|
|
73 !ERROR: PURE procedure pointer 'p_pure' may not be associated with non-PURE procedure designator 'f_impure'
|
|
|
74 p_pure => f_impure
|
|
|
75 contains
|
|
|
76 pure integer function f_pure()
|
|
|
77 f_pure = 1
|
|
|
78 end
|
|
|
79 integer function f_impure()
|
|
|
80 f_impure = 1
|
|
|
81 end
|
|
|
82 elemental integer function f_elemental()
|
|
|
83 f_elemental = 1
|
|
|
84 end
|
|
|
85 end
|
|
|
86
|
|
|
87 ! 10.2.2.4(4)
|
|
|
88 subroutine s6
|
|
|
89 procedure(s), pointer :: p, q
|
|
|
90 procedure(), pointer :: r
|
|
|
91 external :: s_external
|
|
|
92 !ERROR: Procedure pointer 'p' with explicit interface may not be associated with procedure designator 's_external' with implicit interface
|
|
|
93 p => s_external
|
|
|
94 !ERROR: Procedure pointer 'r' with implicit interface may not be associated with procedure designator 's_module' with explicit interface
|
|
|
95 r => s_module
|
|
|
96 end
|
|
|
97
|
|
|
98 ! 10.2.2.4(5)
|
|
|
99 subroutine s7
|
|
|
100 procedure(real) :: f_external
|
|
|
101 external :: s_external
|
|
|
102 procedure(), pointer :: p_s
|
|
|
103 procedure(real), pointer :: p_f
|
|
|
104 p_f => f_external
|
|
|
105 p_s => s_external
|
|
|
106 !ERROR: Subroutine pointer 'p_s' may not be associated with function designator 'f_external'
|
|
|
107 p_s => f_external
|
|
|
108 !ERROR: Function pointer 'p_f' may not be associated with subroutine designator 's_external'
|
|
|
109 p_f => s_external
|
|
|
110 end
|
|
|
111
|
|
|
112 ! C1017: bounds-spec
|
|
|
113 subroutine s8
|
|
|
114 real, target :: x(10, 10)
|
|
|
115 real, pointer :: p(:, :)
|
|
|
116 p(2:,3:) => x
|
|
|
117 !ERROR: Pointer 'p' has rank 2 but the number of bounds specified is 1
|
|
|
118 p(2:) => x
|
|
|
119 end
|
|
|
120
|
|
|
121 ! bounds-remapping
|
|
|
122 subroutine s9
|
|
|
123 real, target :: x(10, 10), y(100)
|
|
|
124 real, pointer :: p(:, :)
|
|
|
125 ! C1018
|
|
|
126 !ERROR: Pointer 'p' has rank 2 but the number of bounds specified is 1
|
|
|
127 p(1:100) => x
|
|
|
128 ! 10.2.2.3(9)
|
|
|
129 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous
|
|
|
130 p(1:5,1:5) => x(1:10,::2)
|
|
|
131 ! 10.2.2.3(9)
|
|
|
132 !ERROR: Pointer bounds require 25 elements but target has only 20
|
|
|
133 p(1:5,1:5) => x(:,1:2)
|
|
|
134 !OK - rhs has rank 1 and enough elements
|
|
|
135 p(1:5,1:5) => y(1:100:2)
|
|
|
136 end
|
|
|
137
|
|
|
138 subroutine s10
|
|
|
139 integer, pointer :: p(:)
|
|
|
140 type :: t
|
|
|
141 integer :: a(4, 4)
|
|
|
142 integer :: b
|
|
|
143 end type
|
|
|
144 type(t), target :: x
|
|
|
145 type(t), target :: y(10,10)
|
|
|
146 integer :: v(10)
|
|
|
147 p(1:16) => x%a
|
|
|
148 p(1:8) => x%a(:,3:4)
|
|
|
149 p(1:1) => x%b ! We treat scalars as simply contiguous
|
|
|
150 p(1:1) => x%a(1,1)
|
|
|
151 p(1:1) => y(1,1)%a(1,1)
|
|
|
152 p(1:1) => y(:,1)%a(1,1) ! Rank 1 RHS
|
|
|
153 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous
|
|
|
154 p(1:4) => x%a(::2,::2)
|
|
|
155 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous
|
|
|
156 p(1:100) => y(:,:)%b
|
|
|
157 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous
|
|
|
158 p(1:100) => y(:,:)%a(1,1)
|
|
|
159 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous
|
|
|
160 !ERROR: An array section with a vector subscript may not be a pointer target
|
|
|
161 p(1:4) => x%a(:,v)
|
|
|
162 end
|
|
|
163
|
|
|
164 subroutine s11
|
|
|
165 complex, target :: x(10,10)
|
|
|
166 complex, pointer :: p(:)
|
|
|
167 real, pointer :: q(:)
|
|
|
168 p(1:100) => x(:,:)
|
|
|
169 q(1:10) => x(1,:)%im
|
|
|
170 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous
|
|
|
171 q(1:100) => x(:,:)%re
|
|
|
172 end
|
|
|
173
|
|
|
174 ! Check is_contiguous, which is usually the same as when pointer bounds
|
|
|
175 ! remapping is used. If it's not simply contiguous it's not constant so
|
|
|
176 ! an error is reported.
|
|
|
177 subroutine s12
|
|
|
178 integer, pointer :: p(:)
|
|
|
179 type :: t
|
|
|
180 integer :: a(4, 4)
|
|
|
181 integer :: b
|
|
|
182 end type
|
|
|
183 type(t), target :: x
|
|
|
184 type(t), target :: y(10,10)
|
|
|
185 integer :: v(10)
|
|
|
186 logical, parameter :: l1 = is_contiguous(x%a(:,:))
|
|
|
187 logical, parameter :: l2 = is_contiguous(y(1,1)%a(1,1))
|
|
|
188 !ERROR: Must be a constant value
|
|
|
189 logical, parameter :: l3 = is_contiguous(y(:,1)%a(1,1))
|
|
|
190 !ERROR: Must be a constant value
|
|
|
191 logical, parameter :: l4 = is_contiguous(x%a(:,v))
|
|
|
192 !ERROR: Must be a constant value
|
|
|
193 logical, parameter :: l5 = is_contiguous(y(v,1)%a(1,1))
|
|
|
194 end
|
|
|
195 subroutine test3(b)
|
|
|
196 integer, intent(inout) :: b(..)
|
|
|
197 !ERROR: Must be a constant value
|
|
|
198 integer, parameter :: i = rank(b)
|
|
|
199 end subroutine
|
|
|
200
|
|
|
201
|
|
|
202 end
|
