1! RUN: %python %S/test_errors.py %s %flang_fc1 2! Pointer assignment constraints 10.2.2.2 (see also assign02.f90) 3 4module m0 5 procedure(),pointer,save :: p 6end 7 8module m 9 interface 10 subroutine s(i) 11 integer i 12 end 13 end interface 14 type :: t 15 procedure(s), pointer, nopass :: p 16 real, pointer :: q 17 end type 18contains 19 ! C1027 20 subroutine s1 21 type(t), allocatable :: a(:) 22 type(t), allocatable :: b[:] 23 a(1)%p => s 24 !ERROR: The left-hand side of a pointer assignment is not definable 25 !BECAUSE: Procedure pointer 'p' may not be a coindexed object 26 b[1]%p => s 27 end 28 ! C1028 29 subroutine s2 30 type(t) :: a 31 a%p => s 32 !ERROR: In assignment to object pointer 'q', the target 's' is a procedure designator 33 a%q => s 34 end 35 ! C1029 36 subroutine s3 37 type(t) :: a 38 a%p => f() ! OK: pointer-valued function 39 !ERROR: Subroutine pointer 'p' may not be associated with function designator 'f' 40 a%p => f 41 contains 42 function f() 43 procedure(s), pointer :: f 44 f => s 45 end 46 end 47 48 ! C1030 and 10.2.2.4 - procedure names as target of procedure pointer 49 subroutine s4(s_dummy) 50 procedure(s) :: s_dummy 51 procedure(s), pointer :: p, q 52 procedure(), pointer :: r 53 integer :: i 54 external :: s_external 55 p => s_dummy 56 p => s_internal 57 p => s_module 58 q => p 59 r => s_external 60 contains 61 subroutine s_internal(i) 62 integer i 63 end 64 end 65 subroutine s_module(i) 66 integer i 67 end 68 69 ! 10.2.2.4(3) 70 subroutine s5 71 procedure(f_impure1), pointer :: p_impure 72 procedure(f_pure1), pointer :: p_pure 73 !ERROR: Procedure pointer 'p_elemental' may not be ELEMENTAL 74 procedure(f_elemental1), pointer :: p_elemental 75 procedure(s_impure1), pointer :: sp_impure 76 procedure(s_pure1), pointer :: sp_pure 77 !ERROR: Procedure pointer 'sp_elemental' may not be ELEMENTAL 78 procedure(s_elemental1), pointer :: sp_elemental 79 80 p_impure => f_impure1 ! OK, same characteristics 81 p_impure => f_pure1 ! OK, target may be pure when pointer is not 82 !ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_elemental1': incompatible procedure attributes: Elemental 83 p_impure => f_elemental1 84 !ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_impureelemental1': incompatible procedure attributes: Elemental 85 p_impure => f_ImpureElemental1 ! OK, target may be elemental 86 87 sp_impure => s_impure1 ! OK, same characteristics 88 sp_impure => s_pure1 ! OK, target may be pure when pointer is not 89 !ERROR: Procedure pointer 'sp_impure' associated with incompatible procedure designator 's_elemental1': incompatible procedure attributes: Elemental 90 sp_impure => s_elemental1 91 92 !ERROR: PURE procedure pointer 'p_pure' may not be associated with non-PURE procedure designator 'f_impure1' 93 p_pure => f_impure1 94 p_pure => f_pure1 ! OK, same characteristics 95 !ERROR: Procedure pointer 'p_pure' associated with incompatible procedure designator 'f_elemental1': incompatible procedure attributes: Elemental 96 p_pure => f_elemental1 97 !ERROR: PURE procedure pointer 'p_pure' may not be associated with non-PURE procedure designator 'f_impureelemental1' 98 p_pure => f_impureElemental1 99 100 !ERROR: PURE procedure pointer 'sp_pure' may not be associated with non-PURE procedure designator 's_impure1' 101 sp_pure => s_impure1 102 sp_pure => s_pure1 ! OK, same characteristics 103 !ERROR: Procedure pointer 'sp_pure' associated with incompatible procedure designator 's_elemental1': incompatible procedure attributes: Elemental 104 sp_pure => s_elemental1 ! OK, target may be elemental when pointer is not 105 106 !ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_impure2': incompatible dummy argument #1: incompatible dummy data object intents 107 p_impure => f_impure2 108 !ERROR: Function pointer 'p_pure' associated with incompatible function designator 'f_pure2': function results have distinct types: INTEGER(4) vs REAL(4) 109 p_pure => f_pure2 110 !ERROR: Function pointer 'p_pure' associated with incompatible function designator 'ccos': function results have distinct types: INTEGER(4) vs COMPLEX(4) 111 p_pure => ccos 112 !ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_elemental2': incompatible procedure attributes: Elemental 113 p_impure => f_elemental2 114 115 !ERROR: Procedure pointer 'sp_impure' associated with incompatible procedure designator 's_impure2': incompatible procedure attributes: BindC 116 sp_impure => s_impure2 117 !ERROR: Procedure pointer 'sp_impure' associated with incompatible procedure designator 's_pure2': incompatible dummy argument #1: incompatible dummy data object intents 118 sp_impure => s_pure2 119 !ERROR: Procedure pointer 'sp_pure' associated with incompatible procedure designator 's_elemental2': incompatible procedure attributes: Elemental 120 sp_pure => s_elemental2 121 122 !ERROR: Function pointer 'p_impure' may not be associated with subroutine designator 's_impure1' 123 p_impure => s_impure1 124 125 !ERROR: Subroutine pointer 'sp_impure' may not be associated with function designator 'f_impure1' 126 sp_impure => f_impure1 127 128 contains 129 integer function f_impure1(n) 130 real, intent(in) :: n 131 f_impure = n 132 end 133 pure integer function f_pure1(n) 134 real, intent(in) :: n 135 f_pure = n 136 end 137 elemental integer function f_elemental1(n) 138 real, intent(in) :: n 139 f_elemental = n 140 end 141 impure elemental integer function f_impureElemental1(n) 142 real, intent(in) :: n 143 f_impureElemental = n 144 end 145 146 integer function f_impure2(n) 147 real, intent(inout) :: n 148 f_impure = n 149 end 150 pure real function f_pure2(n) 151 real, intent(in) :: n 152 f_pure = n 153 end 154 elemental integer function f_elemental2(n) 155 real, value :: n 156 f_elemental = n 157 end 158 159 subroutine s_impure1(n) 160 integer, intent(inout) :: n 161 n = n + 1 162 end 163 pure subroutine s_pure1(n) 164 integer, intent(inout) :: n 165 n = n + 1 166 end 167 elemental subroutine s_elemental1(n) 168 integer, intent(inout) :: n 169 n = n + 1 170 end 171 172 subroutine s_impure2(n) bind(c) 173 integer, intent(inout) :: n 174 n = n + 1 175 end subroutine s_impure2 176 pure subroutine s_pure2(n) 177 integer, intent(out) :: n 178 n = 1 179 end subroutine s_pure2 180 elemental subroutine s_elemental2(m,n) 181 integer, intent(inout) :: m, n 182 n = m + n 183 end subroutine s_elemental2 184 end 185 186 ! 10.2.2.4(4) 187 subroutine s6 188 procedure(s), pointer :: p, q 189 procedure(), pointer :: r 190 external :: s_external 191 p => s_external ! OK for a pointer with an explicit interface to be associated with a procedure with an implicit interface 192 r => s_module ! OK for a pointer with implicit interface to be associated with a procedure with an explicit interface. See 10.2.2.4 (3) 193 end 194 195 ! 10.2.2.4(5) 196 subroutine s7 197 procedure(real) :: f_external 198 external :: s_external 199 procedure(), pointer :: p_s 200 procedure(real), pointer :: p_f 201 p_f => f_external 202 p_s => s_external 203 !Ok: p_s has no interface 204 p_s => f_external 205 !Ok: s_external has no interface 206 p_f => s_external 207 end 208 209 ! C1017: bounds-spec 210 subroutine s8 211 real, target :: x(10, 10) 212 real, pointer :: p(:, :) 213 p(2:,3:) => x 214 !ERROR: Pointer 'p' has rank 2 but the number of bounds specified is 1 215 p(2:) => x 216 end 217 218 ! bounds-remapping 219 subroutine s9 220 real, target :: x(10, 10), y(100) 221 real, pointer :: p(:, :) 222 ! C1018 223 !ERROR: Pointer 'p' has rank 2 but the number of bounds specified is 1 224 p(1:100) => x 225 ! 10.2.2.3(9) 226 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous 227 p(1:5,1:5) => x(1:10,::2) 228 ! 10.2.2.3(9) 229 !ERROR: Pointer bounds require 25 elements but target has only 20 230 p(1:5,1:5) => x(:,1:2) 231 !OK - rhs has rank 1 and enough elements 232 p(1:5,1:5) => y(1:100:2) 233 !OK - same, but from function result 234 p(1:5,1:5) => f() 235 contains 236 function f() 237 real, pointer :: f(:) 238 f => y 239 end function 240 end 241 242 subroutine s10 243 integer, pointer :: p(:) 244 type :: t 245 integer :: a(4, 4) 246 integer :: b 247 end type 248 type(t), target :: x 249 type(t), target :: y(10,10) 250 integer :: v(10) 251 p(1:16) => x%a 252 p(1:8) => x%a(:,3:4) 253 p(1:1) => x%b ! We treat scalars as simply contiguous 254 p(1:1) => x%a(1,1) 255 p(1:1) => y(1,1)%a(1,1) 256 p(1:1) => y(:,1)%a(1,1) ! Rank 1 RHS 257 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous 258 p(1:4) => x%a(::2,::2) 259 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous 260 p(1:100) => y(:,:)%b 261 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous 262 p(1:100) => y(:,:)%a(1,1) 263 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous 264 !ERROR: An array section with a vector subscript may not be a pointer target 265 p(1:4) => x%a(:,v) 266 end 267 268 subroutine s11 269 complex, target :: x(10,10) 270 complex, pointer :: p(:) 271 real, pointer :: q(:) 272 p(1:100) => x(:,:) 273 q(1:10) => x(1,:)%im 274 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous 275 q(1:100) => x(:,:)%re 276 end 277 278 ! Check is_contiguous, which is usually the same as when pointer bounds 279 ! remapping is used. 280 subroutine s12 281 integer, pointer :: p(:) 282 integer, pointer, contiguous :: pc(:) 283 type :: t 284 integer :: a(4, 4) 285 integer :: b 286 end type 287 type(t), target :: x 288 type(t), target :: y(10,10) 289 integer :: v(10) 290 logical(kind=merge(1,-1,is_contiguous(x%a(:,:)))) :: l1 ! known true 291 logical(kind=merge(1,-1,is_contiguous(y(1,1)%a(1,1)))) :: l2 ! known true 292 !ERROR: Must be a constant value 293 logical(kind=merge(-1,-2,is_contiguous(y(:,1)%a(1,1)))) :: l3 ! unknown 294 !ERROR: Must be a constant value 295 logical(kind=merge(-1,-2,is_contiguous(y(:,1)%a(1,1)))) :: l4 ! unknown 296 logical(kind=merge(-1,1,is_contiguous(x%a(:,v)))) :: l5 ! known false 297 !ERROR: Must be a constant value 298 logical(kind=merge(-1,-2,is_contiguous(y(v,1)%a(1,1)))) :: l6 ! unknown 299 !ERROR: Must be a constant value 300 logical(kind=merge(-1,-2,is_contiguous(p(:)))) :: l7 ! unknown 301 logical(kind=merge(1,-1,is_contiguous(pc(:)))) :: l8 ! known true 302 logical(kind=merge(-1,1,is_contiguous(pc(1:10:2)))) :: l9 ! known false 303 logical(kind=merge(-1,1,is_contiguous(pc(10:1:-1)))) :: l10 ! known false 304 logical(kind=merge(1,-1,is_contiguous(pc(1:10:1)))) :: l11 ! known true 305 logical(kind=merge(-1,1,is_contiguous(pc(10:1:-1)))) :: l12 ! known false 306 !ERROR: Must be a constant value 307 logical(kind=merge(-1,1,is_contiguous(pc(::-1)))) :: l13 ! unknown (could be empty) 308 logical(kind=merge(1,-1,is_contiguous(y(1,1)%a(::-1,1)))) :: l14 ! known true (empty) 309 logical(kind=merge(1,-1,is_contiguous(y(1,1)%a(1,::-1)))) :: l15 ! known true (empty) 310 end 311 subroutine test3(b) 312 integer, intent(inout) :: b(..) 313 !ERROR: Must be a constant value 314 integer, parameter :: i = rank(b) 315 end subroutine 316 317 subroutine s13 318 external :: s_external 319 procedure(), pointer :: ptr 320 !Ok - don't emit an error about incompatible Subroutine attribute 321 ptr => s_external 322 call ptr 323 end subroutine 324 325 subroutine s14 326 procedure(real), pointer :: ptr 327 sf(x) = x + 1. 328 !ERROR: Statement function 'sf' may not be the target of a pointer assignment 329 ptr => sf 330 end subroutine 331 332 subroutine s15 333 use m0 334 intrinsic sin 335 p=>sin ! ok 336 end 337end 338