338 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Pointer assignment constraints 10.2.2.2 (see also assign02.f90)3 4module m05 procedure(),pointer,save :: p6end7 8module m9 interface10 subroutine s(i)11 integer i12 end13 end interface14 type :: t15 procedure(s), pointer, nopass :: p16 real, pointer :: q17 end type18contains19 ! C102720 subroutine s121 type(t), allocatable :: a(:)22 type(t), allocatable :: b[:]23 a(1)%p => s24 !ERROR: The left-hand side of a pointer assignment is not definable25 !BECAUSE: Procedure pointer 'p' may not be a coindexed object26 b[1]%p => s27 end28 ! C102829 subroutine s230 type(t) :: a31 a%p => s32 !ERROR: In assignment to object pointer 'q', the target 's' is a procedure designator33 a%q => s34 end35 ! C102936 subroutine s337 type(t) :: a38 a%p => f() ! OK: pointer-valued function39 !ERROR: Subroutine pointer 'p' may not be associated with function designator 'f'40 a%p => f41 contains42 function f()43 procedure(s), pointer :: f44 f => s45 end46 end47 48 ! C1030 and 10.2.2.4 - procedure names as target of procedure pointer49 subroutine s4(s_dummy)50 procedure(s) :: s_dummy51 procedure(s), pointer :: p, q52 procedure(), pointer :: r53 integer :: i54 external :: s_external55 p => s_dummy56 p => s_internal57 p => s_module58 q => p59 r => s_external60 contains61 subroutine s_internal(i)62 integer i63 end64 end65 subroutine s_module(i)66 integer i67 end68 69 ! 10.2.2.4(3)70 subroutine s571 procedure(f_impure1), pointer :: p_impure72 procedure(f_pure1), pointer :: p_pure73 !ERROR: Procedure pointer 'p_elemental' may not be ELEMENTAL74 procedure(f_elemental1), pointer :: p_elemental75 procedure(s_impure1), pointer :: sp_impure76 procedure(s_pure1), pointer :: sp_pure77 !ERROR: Procedure pointer 'sp_elemental' may not be ELEMENTAL78 procedure(s_elemental1), pointer :: sp_elemental79 80 p_impure => f_impure1 ! OK, same characteristics81 p_impure => f_pure1 ! OK, target may be pure when pointer is not82 !ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_elemental1': incompatible procedure attributes: Elemental83 p_impure => f_elemental184 !ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_impureelemental1': incompatible procedure attributes: Elemental85 p_impure => f_ImpureElemental1 ! OK, target may be elemental86 87 sp_impure => s_impure1 ! OK, same characteristics88 sp_impure => s_pure1 ! OK, target may be pure when pointer is not89 !ERROR: Procedure pointer 'sp_impure' associated with incompatible procedure designator 's_elemental1': incompatible procedure attributes: Elemental90 sp_impure => s_elemental191 92 !ERROR: PURE procedure pointer 'p_pure' may not be associated with non-PURE procedure designator 'f_impure1'93 p_pure => f_impure194 p_pure => f_pure1 ! OK, same characteristics95 !ERROR: Procedure pointer 'p_pure' associated with incompatible procedure designator 'f_elemental1': incompatible procedure attributes: Elemental96 p_pure => f_elemental197 !ERROR: PURE procedure pointer 'p_pure' may not be associated with non-PURE procedure designator 'f_impureelemental1'98 p_pure => f_impureElemental199 100 !ERROR: PURE procedure pointer 'sp_pure' may not be associated with non-PURE procedure designator 's_impure1'101 sp_pure => s_impure1102 sp_pure => s_pure1 ! OK, same characteristics103 !ERROR: Procedure pointer 'sp_pure' associated with incompatible procedure designator 's_elemental1': incompatible procedure attributes: Elemental104 sp_pure => s_elemental1 ! OK, target may be elemental when pointer is not105 106 !ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_impure2': incompatible dummy argument #1: incompatible dummy data object intents107 p_impure => f_impure2108 !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_pure2110 !ERROR: Function pointer 'p_pure' associated with incompatible function designator 'ccos': function results have distinct types: INTEGER(4) vs COMPLEX(4)111 p_pure => ccos112 !ERROR: Procedure pointer 'p_impure' associated with incompatible procedure designator 'f_elemental2': incompatible procedure attributes: Elemental113 p_impure => f_elemental2114 115 !ERROR: Procedure pointer 'sp_impure' associated with incompatible procedure designator 's_impure2': incompatible procedure attributes: BindC116 sp_impure => s_impure2117 !ERROR: Procedure pointer 'sp_impure' associated with incompatible procedure designator 's_pure2': incompatible dummy argument #1: incompatible dummy data object intents118 sp_impure => s_pure2119 !ERROR: Procedure pointer 'sp_pure' associated with incompatible procedure designator 's_elemental2': incompatible procedure attributes: Elemental120 sp_pure => s_elemental2121 122 !ERROR: Function pointer 'p_impure' may not be associated with subroutine designator 's_impure1'123 p_impure => s_impure1124 125 !ERROR: Subroutine pointer 'sp_impure' may not be associated with function designator 'f_impure1'126 sp_impure => f_impure1127 128 contains129 integer function f_impure1(n)130 real, intent(in) :: n131 f_impure = n132 end133 pure integer function f_pure1(n)134 real, intent(in) :: n135 f_pure = n136 end137 elemental integer function f_elemental1(n)138 real, intent(in) :: n139 f_elemental = n140 end141 impure elemental integer function f_impureElemental1(n)142 real, intent(in) :: n143 f_impureElemental = n144 end145 146 integer function f_impure2(n)147 real, intent(inout) :: n148 f_impure = n149 end150 pure real function f_pure2(n)151 real, intent(in) :: n152 f_pure = n153 end154 elemental integer function f_elemental2(n)155 real, value :: n156 f_elemental = n157 end158 159 subroutine s_impure1(n)160 integer, intent(inout) :: n161 n = n + 1162 end163 pure subroutine s_pure1(n)164 integer, intent(inout) :: n165 n = n + 1166 end167 elemental subroutine s_elemental1(n)168 integer, intent(inout) :: n169 n = n + 1170 end171 172 subroutine s_impure2(n) bind(c)173 integer, intent(inout) :: n174 n = n + 1175 end subroutine s_impure2176 pure subroutine s_pure2(n)177 integer, intent(out) :: n178 n = 1179 end subroutine s_pure2180 elemental subroutine s_elemental2(m,n)181 integer, intent(inout) :: m, n182 n = m + n183 end subroutine s_elemental2184 end185 186 ! 10.2.2.4(4)187 subroutine s6188 procedure(s), pointer :: p, q189 procedure(), pointer :: r190 external :: s_external191 p => s_external ! OK for a pointer with an explicit interface to be associated with a procedure with an implicit interface192 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 end194 195 ! 10.2.2.4(5)196 subroutine s7197 procedure(real) :: f_external198 external :: s_external199 procedure(), pointer :: p_s200 procedure(real), pointer :: p_f201 p_f => f_external202 p_s => s_external203 !Ok: p_s has no interface204 p_s => f_external205 !Ok: s_external has no interface206 p_f => s_external207 end208 209 ! C1017: bounds-spec210 subroutine s8211 real, target :: x(10, 10)212 real, pointer :: p(:, :)213 p(2:,3:) => x214 !ERROR: Pointer 'p' has rank 2 but the number of bounds specified is 1215 p(2:) => x216 end217 218 ! bounds-remapping219 subroutine s9220 real, target :: x(10, 10), y(100)221 real, pointer :: p(:, :)222 ! C1018223 !ERROR: Pointer 'p' has rank 2 but the number of bounds specified is 1224 p(1:100) => x225 ! 10.2.2.3(9)226 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous227 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 20230 p(1:5,1:5) => x(:,1:2)231 !OK - rhs has rank 1 and enough elements232 p(1:5,1:5) => y(1:100:2)233 !OK - same, but from function result234 p(1:5,1:5) => f()235 contains236 function f()237 real, pointer :: f(:)238 f => y239 end function240 end241 242 subroutine s10243 integer, pointer :: p(:)244 type :: t245 integer :: a(4, 4)246 integer :: b247 end type248 type(t), target :: x249 type(t), target :: y(10,10)250 integer :: v(10)251 p(1:16) => x%a252 p(1:8) => x%a(:,3:4)253 p(1:1) => x%b ! We treat scalars as simply contiguous254 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 RHS257 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous258 p(1:4) => x%a(::2,::2)259 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous260 p(1:100) => y(:,:)%b261 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous262 p(1:100) => y(:,:)%a(1,1)263 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous264 !ERROR: An array section with a vector subscript may not be a pointer target265 p(1:4) => x%a(:,v)266 end267 268 subroutine s11269 complex, target :: x(10,10)270 complex, pointer :: p(:)271 real, pointer :: q(:)272 p(1:100) => x(:,:)273 q(1:10) => x(1,:)%im274 !ERROR: Pointer bounds remapping target must have rank 1 or be simply contiguous275 q(1:100) => x(:,:)%re276 end277 278 ! Check is_contiguous, which is usually the same as when pointer bounds279 ! remapping is used.280 subroutine s12281 integer, pointer :: p(:)282 integer, pointer, contiguous :: pc(:)283 type :: t284 integer :: a(4, 4)285 integer :: b286 end type287 type(t), target :: x288 type(t), target :: y(10,10)289 integer :: v(10)290 logical(kind=merge(1,-1,is_contiguous(x%a(:,:)))) :: l1 ! known true291 logical(kind=merge(1,-1,is_contiguous(y(1,1)%a(1,1)))) :: l2 ! known true292 !ERROR: Must be a constant value293 logical(kind=merge(-1,-2,is_contiguous(y(:,1)%a(1,1)))) :: l3 ! unknown294 !ERROR: Must be a constant value295 logical(kind=merge(-1,-2,is_contiguous(y(:,1)%a(1,1)))) :: l4 ! unknown296 logical(kind=merge(-1,1,is_contiguous(x%a(:,v)))) :: l5 ! known false297 !ERROR: Must be a constant value298 logical(kind=merge(-1,-2,is_contiguous(y(v,1)%a(1,1)))) :: l6 ! unknown299 !ERROR: Must be a constant value300 logical(kind=merge(-1,-2,is_contiguous(p(:)))) :: l7 ! unknown301 logical(kind=merge(1,-1,is_contiguous(pc(:)))) :: l8 ! known true302 logical(kind=merge(-1,1,is_contiguous(pc(1:10:2)))) :: l9 ! known false303 logical(kind=merge(-1,1,is_contiguous(pc(10:1:-1)))) :: l10 ! known false304 logical(kind=merge(1,-1,is_contiguous(pc(1:10:1)))) :: l11 ! known true305 logical(kind=merge(-1,1,is_contiguous(pc(10:1:-1)))) :: l12 ! known false306 !ERROR: Must be a constant value307 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 end311 subroutine test3(b)312 integer, intent(inout) :: b(..)313 !ERROR: Must be a constant value314 integer, parameter :: i = rank(b)315 end subroutine316 317 subroutine s13318 external :: s_external319 procedure(), pointer :: ptr320 !Ok - don't emit an error about incompatible Subroutine attribute321 ptr => s_external322 call ptr323 end subroutine324 325 subroutine s14326 procedure(real), pointer :: ptr327 sf(x) = x + 1.328 !ERROR: Statement function 'sf' may not be the target of a pointer assignment329 ptr => sf330 end subroutine331 332 subroutine s15333 use m0334 intrinsic sin335 p=>sin ! ok336 end337end338