test/Semantics/assign04.f90

! 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]
  associate (y => x) ! ok
    !ERROR: Whole assumed-size array 'y' may not appear here without subscripts
    y = [1, 2, 3]
  end associate
  !ERROR: Whole assumed-size array 'x' may not appear here without subscripts
  associate (y => (x))
  end associate
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