llvm/flang/test/Semantics/definable01.f90

! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
! Test WhyNotDefinable() explanations

module prot
  real, protected :: prot
  type :: ptype
    real, pointer :: ptr
    real :: x
  end type
  type(ptype), protected :: protptr
 contains
  subroutine ok
    prot = 0. ! ok
  end subroutine
end module

module m
  use iso_fortran_env
  use prot
  type :: t1
    type(lock_type) :: lock
  end type
  type :: t2
    type(t1) :: x1
    real :: x2
  end type
  type(t2) :: t2static
  type list
    real a
    type(list), pointer :: prev, next
  end type
  character(*), parameter :: internal = '0'
 contains
  subroutine test1(dummy)
    real :: arr(2)
    integer, parameter :: j3 = 666
    type(ptype), intent(in) :: dummy
    type(t2) :: t2var
    associate (a => 3+4)
      !CHECK: error: Input variable 'a' is not definable
      !CHECK: because: 'a' is construct associated with an expression
      read(internal,*) a
    end associate
    associate (a => arr([1])) ! vector subscript
      !CHECK: error: Input variable 'a' is not definable
      !CHECK: because: Construct association 'a' has a vector subscript
      read(internal,*) a
    end associate
    associate (a => arr(2:1:-1))
      read(internal,*) a ! ok
    end associate
    !CHECK: error: Input variable 'j3' is not definable
    !CHECK: because: '666_4' is not a variable
    read(internal,*) j3
    !CHECK: error: Left-hand side of assignment is not definable
    !CHECK: because: 't2var' is an entity with either an EVENT_TYPE or LOCK_TYPE
    t2var = t2static
    t2var%x2 = 0. ! ok
    !CHECK: error: Left-hand side of assignment is not definable
    !CHECK: because: 'prot' is protected in this scope
    prot = 0.
    protptr%ptr = 0. ! ok
    !CHECK: error: Left-hand side of assignment is not definable
    !CHECK: because: 'dummy' is an INTENT(IN) dummy argument
    dummy%x = 0.
    dummy%ptr = 0. ! ok
  end subroutine
  pure subroutine test2(ptr)
    integer, pointer, intent(in) :: ptr
    !CHECK: error: Input variable 'ptr' is not definable
    !CHECK: because: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram
    read(internal,*) ptr
  end subroutine
  subroutine test3(objp, procp)
    real, intent(in), pointer :: objp
    procedure(sin), pointer, intent(in) :: procp
    !CHECK: error: Actual argument associated with INTENT(IN OUT) dummy argument 'op=' is not definable
    !CHECK: because: 'objp' is an INTENT(IN) dummy argument
    call test3a(objp)
    !CHECK: error: Actual argument associated with procedure pointer dummy argument 'pp=' may not be INTENT(IN)
    call test3b(procp)
  end subroutine
  subroutine test3a(op)
    real, intent(in out), pointer :: op
  end subroutine
  subroutine test3b(pp)
    procedure(sin), pointer, intent(in out) :: pp
  end subroutine
  subroutine test4(p)
    type(ptype), pointer, intent(in) :: p
    p%x = 1.
    p%ptr = 1. ! ok
    nullify(p%ptr) ! ok
    !CHECK: error: 'p' may not appear in NULLIFY
    !CHECK: because: 'p' is an INTENT(IN) dummy argument
    nullify(p)
  end
  subroutine test5(np)
    type(ptype), intent(in) :: np
    !CHECK: error: 'ptr' may not appear in NULLIFY
    !CHECK: because: 'np' is an INTENT(IN) dummy argument
    nullify(np%ptr)
  end
  pure function test6(lp)
    type(list), pointer :: lp
    !CHECK: error: The left-hand side of a pointer assignment is not definable
    !CHECK: because: 'lp' may not be defined in pure subprogram 'test6' because it is a POINTER dummy argument of a pure function
    lp%next%next => null()
  end
  pure subroutine test7(lp)
    type(list), pointer :: lp
    !CHECK-NOT: error:
    lp%next%next => null()
  end
end module