1! RUN: %python %S/test_errors.py %s %flang_fc1 2! 9.4.5 3subroutine s1 4 type :: t(k, l) 5 integer, kind :: k 6 integer, len :: l 7 end type 8 type(t(1, 2)) :: x 9 !ERROR: Assignment to constant 'x%k' is not allowed 10 x%k = 4 11 !ERROR: Assignment to constant 'x%l' is not allowed 12 x%l = 3 13end 14 15! C901 16subroutine s2(x) 17 !ERROR: A dummy argument may not also be a named constant 18 real, parameter :: x = 0.0 19 real, parameter :: a(*) = [1, 2, 3] 20 character, parameter :: c(2) = "ab" 21 integer :: i 22 !ERROR: Assignment to constant 'x' is not allowed 23 x = 2.0 24 i = 2 25 !ERROR: Left-hand side of assignment is not definable 26 !BECAUSE: 'a' is not a variable 27 a(i) = 3.0 28 !ERROR: Left-hand side of assignment is not definable 29 !BECAUSE: 'a' is not a variable 30 a(i:i+1) = [4, 5] 31 !ERROR: Left-hand side of assignment is not definable 32 !BECAUSE: 'c' is not a variable 33 c(i:2) = "cd" 34end 35 36! C901 37subroutine s3 38 type :: t 39 integer :: a(2) 40 integer :: b 41 end type 42 type(t) :: x 43 type(t), parameter :: y = t([1,2], 3) 44 integer :: i = 1 45 x%a(i) = 1 46 !ERROR: Left-hand side of assignment is not definable 47 !BECAUSE: 'y' is not a variable 48 y%a(i) = 2 49 x%b = 4 50 !ERROR: Assignment to constant 'y%b' is not allowed 51 y%b = 5 52end 53 54! C844 55subroutine s4 56 type :: t 57 integer :: a(2) 58 end type 59contains 60 subroutine s(x, c) 61 type(t), intent(in) :: x 62 character(10), intent(in) :: c 63 type(t) :: y 64 !ERROR: Left-hand side of assignment is not definable 65 !BECAUSE: 'x' is an INTENT(IN) dummy argument 66 x = y 67 !ERROR: Left-hand side of assignment is not definable 68 !BECAUSE: 'x' is an INTENT(IN) dummy argument 69 x%a(1) = 2 70 !ERROR: Left-hand side of assignment is not definable 71 !BECAUSE: 'c' is an INTENT(IN) dummy argument 72 c(2:3) = "ab" 73 end 74end 75 76! 8.5.15(2) 77module m5 78 real :: x 79 real, protected :: y 80 real, private :: z 81 type :: t 82 real :: a 83 end type 84 type(t), protected :: b 85end 86subroutine s5() 87 use m5 88 implicit none 89 x = 1.0 90 !ERROR: Left-hand side of assignment is not definable 91 !BECAUSE: 'y' is protected in this scope 92 y = 2.0 93 !ERROR: No explicit type declared for 'z' 94 z = 3.0 95 !ERROR: Left-hand side of assignment is not definable 96 !BECAUSE: 'b' is protected in this scope 97 b%a = 1.0 98end 99 100subroutine s6(x) 101 integer :: x(*) 102 x(1:3) = [1, 2, 3] 103 x(:3) = [1, 2, 3] 104 !ERROR: Assumed-size array 'x' must have explicit final subscript upper bound value 105 x(:) = [1, 2, 3] 106 !ERROR: Whole assumed-size array 'x' may not appear here without subscripts 107 x = [1, 2, 3] 108 associate (y => x) ! ok 109 !ERROR: Whole assumed-size array 'y' may not appear here without subscripts 110 y = [1, 2, 3] 111 end associate 112 !ERROR: Whole assumed-size array 'x' may not appear here without subscripts 113 associate (y => (x)) 114 end associate 115end 116 117module m7 118 type :: t 119 integer :: i 120 end type 121contains 122 subroutine s7(x) 123 type(t) :: x(*) 124 x(:3)%i = [1, 2, 3] 125 !ERROR: Whole assumed-size array 'x' may not appear here without subscripts 126 x%i = [1, 2, 3] 127 end 128end 129 130subroutine s7 131 integer :: a(10), v(10) 132 a(v(:)) = 1 ! vector subscript is ok 133end 134 135subroutine s8 136 !ERROR: Assignment to procedure 's8' is not allowed 137 s8 = 1.0 138end 139 140real function f9() result(r) 141 !ERROR: Assignment to procedure 'f9' is not allowed 142 f9 = 1.0 143end 144 145subroutine s9 146 real f9a 147 !ERROR: Assignment to procedure 'f9a' is not allowed 148 f9a = 1.0 149 print *, f9a(1) 150end 151 152!ERROR: No explicit type declared for dummy argument 'n' 153subroutine s10(a, n) 154 implicit none 155 real a(n) 156 a(1:n) = 0.0 ! should not get a second error here 157end 158 159subroutine s11 160 intrinsic :: sin 161 real :: a 162 !ERROR: Function call must have argument list 163 a = sin 164 !ERROR: Subroutine name is not allowed here 165 a = s11 166end 167 168subroutine s12() 169 type dType(l1, k1, l2, k2) 170 integer, len :: l1 171 integer, kind :: k1 172 integer, len :: l2 173 integer, kind :: k2 174 end type 175 176 contains 177 subroutine sub(arg1, arg2, arg3) 178 integer :: arg1 179 type(dType(arg1, 2, *, 4)) :: arg2 180 type(dType(*, 2, arg1, 4)) :: arg3 181 type(dType(1, 2, 3, 4)) :: local1 182 type(dType(1, 2, 3, 4)) :: local2 183 type(dType(1, 2, arg1, 4)) :: local3 184 type(dType(9, 2, 3, 4)) :: local4 185 type(dType(1, 9, 3, 4)) :: local5 186 187 arg2 = arg3 188 arg2 = local1 189 arg3 = local1 190 local1 = local2 191 local2 = local3 192 !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(dtype(k1=2_4,k2=4_4,l1=1_4,l2=3_4)) and TYPE(dtype(k1=2_4,k2=4_4,l1=9_4,l2=3_4)) 193 local1 = local4 ! mismatched constant KIND type parameter 194 !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(dtype(k1=2_4,k2=4_4,l1=1_4,l2=3_4)) and TYPE(dtype(k1=9_4,k2=4_4,l1=1_4,l2=3_4)) 195 local1 = local5 ! mismatched constant LEN type parameter 196 end subroutine sub 197end subroutine s12 198 199subroutine s13() 200 interface assignment(=) 201 procedure :: cToR, cToRa, cToI 202 end interface 203 real :: x(1) 204 integer :: n(1) 205 x='0' ! fine 206 n='0' ! fine 207 !ERROR: Defined assignment in WHERE must be elemental, but 'ctora' is not 208 where ([1==1]) x='*' 209 where ([1==1]) n='*' ! fine 210 forall (j=1:1) 211 !ERROR: The mask or variable must not be scalar 212 where (j==1) 213 !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not 214 !ERROR: The mask or variable must not be scalar 215 x(j)='?' 216 !ERROR: The mask or variable must not be scalar 217 n(j)='?' 218 !ERROR: The mask or variable must not be scalar 219 elsewhere (.false.) 220 !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not 221 !ERROR: The mask or variable must not be scalar 222 x(j)='1' 223 !ERROR: The mask or variable must not be scalar 224 n(j)='1' 225 elsewhere 226 !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not 227 !ERROR: The mask or variable must not be scalar 228 x(j)='9' 229 !ERROR: The mask or variable must not be scalar 230 n(j)='9' 231 end where 232 end forall 233 x='0' ! still fine 234 n='0' ! still fine 235 contains 236 subroutine cToR(x, c) 237 real, intent(out) :: x 238 character, intent(in) :: c 239 end subroutine 240 subroutine cToRa(x, c) 241 real, intent(out) :: x(:) 242 character, intent(in) :: c 243 end subroutine 244 elemental subroutine cToI(n, c) 245 integer, intent(out) :: n 246 character, intent(in) :: c 247 end subroutine 248end subroutine s13 249 250module m14 251 type t1 252 integer, pointer :: p 253 contains 254 procedure definedAsst1 255 generic :: assignment(=) => definedAsst1 256 end type 257 type t2 258 integer, pointer :: p 259 end type 260 interface assignment(=) 261 module procedure definedAsst2 262 end interface 263 type t3 264 integer, pointer :: p 265 end type 266 contains 267 pure subroutine definedAsst1(lhs,rhs) 268 class(t1), intent(in out) :: lhs 269 class(t1), intent(in) :: rhs 270 end subroutine 271 pure subroutine definedAsst2(lhs,rhs) 272 type(t2), intent(out) :: lhs 273 type(t2), intent(in) :: rhs 274 end subroutine 275 pure subroutine test(y1,y2,y3) 276 type(t1) x1 277 type(t1), intent(in) :: y1 278 type(t2) x2 279 type(t2), intent(in) :: y2 280 type(t3) x3 281 type(t3), intent(in) :: y3 282 x1 = y1 ! fine due to not being intrinsic assignment 283 x2 = y2 ! fine due to not being intrinsic assignment 284 !ERROR: A pure subprogram may not copy the value of 'y3' because it is an INTENT(IN) dummy argument and has the POINTER potential subobject component '%p' 285 x3 = y3 286 end subroutine 287end module m14 288