291 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! 9.4.53subroutine s14 type :: t(k, l)5 integer, kind :: k6 integer, len :: l7 end type8 type(t(1, 2)) :: x9 !ERROR: Assignment to constant 'x%k' is not allowed10 x%k = 411 !ERROR: Assignment to constant 'x%l' is not allowed12 x%l = 313end14 15! C90116subroutine s2(x)17 !ERROR: A dummy argument may not also be a named constant18 real, parameter :: x = 0.019 real, parameter :: a(*) = [1, 2, 3]20 character, parameter :: c(2) = "ab"21 integer :: i22 !ERROR: Assignment to constant 'x' is not allowed23 x = 2.024 i = 225 !ERROR: Left-hand side of assignment is not definable26 !BECAUSE: 'a' is not a variable27 a(i) = 3.028 !ERROR: Left-hand side of assignment is not definable29 !BECAUSE: 'a' is not a variable30 a(i:i+1) = [4, 5]31 !ERROR: Left-hand side of assignment is not definable32 !BECAUSE: 'c' is not a variable33 c(i:2) = "cd"34end35 36! C90137subroutine s338 type :: t39 integer :: a(2)40 integer :: b41 end type42 type(t) :: x43 type(t), parameter :: y = t([1,2], 3)44 integer :: i = 145 x%a(i) = 146 !ERROR: Left-hand side of assignment is not definable47 !BECAUSE: 'y' is not a variable48 y%a(i) = 249 x%b = 450 !ERROR: Assignment to constant 'y%b' is not allowed51 y%b = 552end53 54! C84455subroutine s456 type :: t57 integer :: a(2)58 end type59contains60 subroutine s(x, c)61 type(t), intent(in) :: x62 character(10), intent(in) :: c63 type(t) :: y64 !ERROR: Left-hand side of assignment is not definable65 !BECAUSE: 'x' is an INTENT(IN) dummy argument66 x = y67 !ERROR: Left-hand side of assignment is not definable68 !BECAUSE: 'x' is an INTENT(IN) dummy argument69 x%a(1) = 270 !ERROR: Left-hand side of assignment is not definable71 !BECAUSE: 'c' is an INTENT(IN) dummy argument72 c(2:3) = "ab"73 end74end75 76! 8.5.15(2)77module m578 real :: x79 real, protected :: y80 real, private :: z81 type :: t82 real :: a83 end type84 type(t), protected :: b85end86subroutine s5()87 use m588 implicit none89 x = 1.090 !ERROR: Left-hand side of assignment is not definable91 !BECAUSE: 'y' is protected in this scope92 y = 2.093 !ERROR: No explicit type declared for 'z'94 z = 3.095 !ERROR: Left-hand side of assignment is not definable96 !BECAUSE: 'b' is protected in this scope97 b%a = 1.098end99 100subroutine s6(x)101 integer :: x(*)102 integer, allocatable :: ja(:)103 x(1:3) = [1, 2, 3]104 x(:3) = [1, 2, 3]105 !ERROR: Assumed-size array 'x' must have explicit final subscript upper bound value106 x(:) = [1, 2, 3]107 !ERROR: Whole assumed-size array 'x' may not appear here without subscripts108 x = [1, 2, 3]109 !ERROR: Whole assumed-size array 'x' may not appear here without subscripts110 ja = x111 associate (y => x) ! ok112 !ERROR: Whole assumed-size array 'y' may not appear here without subscripts113 y = [1, 2, 3]114 end associate115 !ERROR: Whole assumed-size array 'x' may not appear here without subscripts116 associate (y => (x))117 end associate118end119 120module m7121 type :: t122 integer :: i123 end type124contains125 subroutine s7(x)126 type(t) :: x(*)127 x(:3)%i = [1, 2, 3]128 !ERROR: Whole assumed-size array 'x' may not appear here without subscripts129 x%i = [1, 2, 3]130 end131end132 133subroutine s7134 integer :: a(10), v(10)135 a(v(:)) = 1 ! vector subscript is ok136end137 138subroutine s8139 !ERROR: Assignment to procedure 's8' is not allowed140 s8 = 1.0141end142 143real function f9() result(r)144 !ERROR: Assignment to procedure 'f9' is not allowed145 f9 = 1.0146end147 148subroutine s9149 real f9a150 !ERROR: Assignment to procedure 'f9a' is not allowed151 f9a = 1.0152 print *, f9a(1)153end154 155!ERROR: No explicit type declared for dummy argument 'n'156subroutine s10(a, n)157 implicit none158 real a(n)159 a(1:n) = 0.0 ! should not get a second error here160end161 162subroutine s11163 intrinsic :: sin164 real :: a165 !ERROR: Function call must have argument list166 a = sin167 !ERROR: Subroutine name is not allowed here168 a = s11169end170 171subroutine s12()172 type dType(l1, k1, l2, k2)173 integer, len :: l1174 integer, kind :: k1175 integer, len :: l2176 integer, kind :: k2177 end type178 179 contains180 subroutine sub(arg1, arg2, arg3)181 integer :: arg1182 type(dType(arg1, 2, *, 4)) :: arg2183 type(dType(*, 2, arg1, 4)) :: arg3184 type(dType(1, 2, 3, 4)) :: local1185 type(dType(1, 2, 3, 4)) :: local2186 type(dType(1, 2, arg1, 4)) :: local3187 type(dType(9, 2, 3, 4)) :: local4188 type(dType(1, 9, 3, 4)) :: local5189 190 arg2 = arg3191 arg2 = local1192 arg3 = local1193 local1 = local2194 local2 = local3195 !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))196 local1 = local4 ! mismatched constant KIND type parameter197 !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))198 local1 = local5 ! mismatched constant LEN type parameter199 end subroutine sub200end subroutine s12201 202subroutine s13()203 interface assignment(=)204 procedure :: cToR, cToRa, cToI205 end interface206 real :: x(1)207 integer :: n(1)208 x='0' ! fine209 n='0' ! fine210 !ERROR: Defined assignment in WHERE must be elemental, but 'ctora' is not211 where ([1==1]) x='*'212 where ([1==1]) n='*' ! fine213 forall (j=1:1)214 !ERROR: The mask or variable must not be scalar215 where (j==1)216 !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not217 !ERROR: The mask or variable must not be scalar218 x(j)='?'219 !ERROR: The mask or variable must not be scalar220 n(j)='?'221 !ERROR: The mask or variable must not be scalar222 elsewhere (.false.)223 !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not224 !ERROR: The mask or variable must not be scalar225 x(j)='1'226 !ERROR: The mask or variable must not be scalar227 n(j)='1'228 elsewhere229 !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not230 !ERROR: The mask or variable must not be scalar231 x(j)='9'232 !ERROR: The mask or variable must not be scalar233 n(j)='9'234 end where235 end forall236 x='0' ! still fine237 n='0' ! still fine238 contains239 subroutine cToR(x, c)240 real, intent(out) :: x241 character, intent(in) :: c242 end subroutine243 subroutine cToRa(x, c)244 real, intent(out) :: x(:)245 character, intent(in) :: c246 end subroutine247 elemental subroutine cToI(n, c)248 integer, intent(out) :: n249 character, intent(in) :: c250 end subroutine251end subroutine s13252 253module m14254 type t1255 integer, pointer :: p256 contains257 procedure definedAsst1258 generic :: assignment(=) => definedAsst1259 end type260 type t2261 integer, pointer :: p262 end type263 interface assignment(=)264 module procedure definedAsst2265 end interface266 type t3267 integer, pointer :: p268 end type269 contains270 pure subroutine definedAsst1(lhs,rhs)271 class(t1), intent(in out) :: lhs272 class(t1), intent(in) :: rhs273 end subroutine274 pure subroutine definedAsst2(lhs,rhs)275 type(t2), intent(out) :: lhs276 type(t2), intent(in) :: rhs277 end subroutine278 pure subroutine test(y1,y2,y3)279 type(t1) x1280 type(t1), intent(in) :: y1281 type(t2) x2282 type(t2), intent(in) :: y2283 type(t3) x3284 type(t3), intent(in) :: y3285 x1 = y1 ! fine due to not being intrinsic assignment286 x2 = y2 ! fine due to not being intrinsic assignment287 !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'288 x3 = y3289 end subroutine290end module m14291