! RUN: %python %S/test_errors.py %s %flang_fc1 ! 9.4.5 subroutine s1 type :: t(k, l) integer, kind :: k integer, len :: l end type type(t(1, 2)) :: x !ERROR: Assignment to constant 'x%k' is not allowed x%k = 4 !ERROR: Assignment to constant 'x%l' is not allowed x%l = 3 end ! C901 subroutine s2(x) !ERROR: A dummy argument may not also be a named constant real, parameter :: x = 0.0 real, parameter :: a(*) = [1, 2, 3] character, parameter :: c(2) = "ab" integer :: i !ERROR: Assignment to constant 'x' is not allowed x = 2.0 i = 2 !ERROR: Left-hand side of assignment is not definable !BECAUSE: 'a' is not a variable a(i) = 3.0 !ERROR: Left-hand side of assignment is not definable !BECAUSE: 'a' is not a variable a(i:i+1) = [4, 5] !ERROR: Left-hand side of assignment is not definable !BECAUSE: 'c' is not a variable c(i:2) = "cd" end ! C901 subroutine s3 type :: t integer :: a(2) integer :: b end type type(t) :: x type(t), parameter :: y = t([1,2], 3) integer :: i = 1 x%a(i) = 1 !ERROR: Left-hand side of assignment is not definable !BECAUSE: 'y' is not a variable y%a(i) = 2 x%b = 4 !ERROR: Assignment to constant 'y%b' is not allowed y%b = 5 end ! C844 subroutine s4 type :: t integer :: a(2) end type contains subroutine s(x, c) type(t), intent(in) :: x character(10), intent(in) :: c type(t) :: y !ERROR: Left-hand side of assignment is not definable !BECAUSE: 'x' is an INTENT(IN) dummy argument x = y !ERROR: Left-hand side of assignment is not definable !BECAUSE: 'x' is an INTENT(IN) dummy argument x%a(1) = 2 !ERROR: Left-hand side of assignment is not definable !BECAUSE: 'c' is an INTENT(IN) dummy argument c(2:3) = "ab" end end ! 8.5.15(2) module m5 real :: x real, protected :: y real, private :: z type :: t real :: a end type type(t), protected :: b end subroutine s5() use m5 implicit none x = 1.0 !ERROR: Left-hand side of assignment is not definable !BECAUSE: 'y' is protected in this scope y = 2.0 !ERROR: No explicit type declared for 'z' z = 3.0 !ERROR: Left-hand side of assignment is not definable !BECAUSE: 'b' is protected in this scope b%a = 1.0 end subroutine s6(x) integer :: x(*) x(1:3) = [1, 2, 3] x(:3) = [1, 2, 3] !ERROR: Assumed-size array 'x' must have explicit final subscript upper bound value x(:) = [1, 2, 3] !ERROR: Whole assumed-size array 'x' may not appear here without subscripts x = [1, 2, 3] end module m7 type :: t integer :: i end type contains subroutine s7(x) type(t) :: x(*) x(:3)%i = [1, 2, 3] !ERROR: Whole assumed-size array 'x' may not appear here without subscripts x%i = [1, 2, 3] end end subroutine s7 integer :: a(10), v(10) a(v(:)) = 1 ! vector subscript is ok end subroutine s8 !ERROR: Assignment to procedure 's8' is not allowed s8 = 1.0 end real function f9() result(r) !ERROR: Assignment to procedure 'f9' is not allowed f9 = 1.0 end subroutine s9 real f9a !ERROR: Assignment to procedure 'f9a' is not allowed f9a = 1.0 print *, f9a(1) end !ERROR: No explicit type declared for dummy argument 'n' subroutine s10(a, n) implicit none real a(n) a(1:n) = 0.0 ! should not get a second error here end subroutine s11 intrinsic :: sin real :: a !ERROR: Function call must have argument list a = sin !ERROR: Subroutine name is not allowed here a = s11 end subroutine s12() type dType(l1, k1, l2, k2) integer, len :: l1 integer, kind :: k1 integer, len :: l2 integer, kind :: k2 end type contains subroutine sub(arg1, arg2, arg3) integer :: arg1 type(dType(arg1, 2, *, 4)) :: arg2 type(dType(*, 2, arg1, 4)) :: arg3 type(dType(1, 2, 3, 4)) :: local1 type(dType(1, 2, 3, 4)) :: local2 type(dType(1, 2, arg1, 4)) :: local3 type(dType(9, 2, 3, 4)) :: local4 type(dType(1, 9, 3, 4)) :: local5 arg2 = arg3 arg2 = local1 arg3 = local1 local1 = local2 local2 = local3 !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)) local1 = local4 ! mismatched constant KIND type parameter !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)) local1 = local5 ! mismatched constant LEN type parameter end subroutine sub end subroutine s12 subroutine s13() interface assignment(=) procedure :: cToR, cToRa, cToI end interface real :: x(1) integer :: n(1) x='0' ! fine n='0' ! fine !ERROR: Defined assignment in WHERE must be elemental, but 'ctora' is not where ([1==1]) x='*' where ([1==1]) n='*' ! fine forall (j=1:1) !ERROR: The mask or variable must not be scalar where (j==1) !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not !ERROR: The mask or variable must not be scalar x(j)='?' !ERROR: The mask or variable must not be scalar n(j)='?' !ERROR: The mask or variable must not be scalar elsewhere (.false.) !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not !ERROR: The mask or variable must not be scalar x(j)='1' !ERROR: The mask or variable must not be scalar n(j)='1' elsewhere !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not !ERROR: The mask or variable must not be scalar x(j)='9' !ERROR: The mask or variable must not be scalar n(j)='9' end where end forall x='0' ! still fine n='0' ! still fine contains subroutine cToR(x, c) real, intent(out) :: x character, intent(in) :: c end subroutine subroutine cToRa(x, c) real, intent(out) :: x(:) character, intent(in) :: c end subroutine elemental subroutine cToI(n, c) integer, intent(out) :: n character, intent(in) :: c end subroutine end subroutine s13 module m14 type t1 integer, pointer :: p contains procedure definedAsst1 generic :: assignment(=) => definedAsst1 end type type t2 integer, pointer :: p end type interface assignment(=) module procedure definedAsst2 end interface type t3 integer, pointer :: p end type contains pure subroutine definedAsst1(lhs,rhs) class(t1), intent(in out) :: lhs class(t1), intent(in) :: rhs end subroutine pure subroutine definedAsst2(lhs,rhs) type(t2), intent(out) :: lhs type(t2), intent(in) :: rhs end subroutine pure subroutine test(y1,y2,y3) type(t1) x1 type(t1), intent(in) :: y1 type(t2) x2 type(t2), intent(in) :: y2 type(t3) x3 type(t3), intent(in) :: y3 x1 = y1 ! fine due to not being intrinsic assignment x2 = y2 ! fine due to not being intrinsic assignment !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' x3 = y3 end subroutine end module m14