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