flang/test/Semantics/definable01.f90

   1 ! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
   2 ! Test WhyNotDefinable() explanations
   3
   4 module prot
   5   real, protected :: prot
   6   type :: ptype
   7     real, pointer :: ptr
   8     real :: x
   9   end type
  10   type(ptype), protected :: protptr
  11  contains
  12   subroutine ok
  13     prot = 0. ! ok
  14   end subroutine
  15 end module
  16
  17 module m
  18   use iso_fortran_env
  19   use prot
  20   type :: t1
  21     type(lock_type) :: lock
  22   end type
  23   type :: t2
  24     type(t1) :: x1
  25     real :: x2
  26   end type
  27   type(t2) :: t2static
  28   type list
  29     real a
  30     type(list), pointer :: prev, next
  31   end type
  32   character(*), parameter :: internal = '0'
  33  contains
  34   subroutine test1(dummy)
  35     real :: arr(2)
  36     integer, parameter :: j3 = 666
  37     type(ptype), intent(in) :: dummy
  38     type(t2) :: t2var
  39     associate (a => 3+4)
  40       !CHECK: error: Input variable 'a' is not definable
  41       !CHECK: because: 'a' is construct associated with an expression
  42       read(internal,*) a
  43     end associate
  44     associate (a => arr([1])) ! vector subscript
  45       !CHECK: error: Input variable 'a' is not definable
  46       !CHECK: because: Construct association 'a' has a vector subscript
  47       read(internal,*) a
  48     end associate
  49     associate (a => arr(2:1:-1))
  50       read(internal,*) a ! ok
  51     end associate
  52     !CHECK: error: Input variable 'j3' is not definable
  53     !CHECK: because: '666_4' is not a variable
  54     read(internal,*) j3
  55     !CHECK: error: Left-hand side of assignment is not definable
  56     !CHECK: because: 't2var' is an entity with either an EVENT_TYPE or LOCK_TYPE
  57     t2var = t2static
  58     t2var%x2 = 0. ! ok
  59     !CHECK: error: Left-hand side of assignment is not definable
  60     !CHECK: because: 'prot' is protected in this scope
  61     prot = 0.
  62     protptr%ptr = 0. ! ok
  63     !CHECK: error: Left-hand side of assignment is not definable
  64     !CHECK: because: 'dummy' is an INTENT(IN) dummy argument
  65     dummy%x = 0.
  66     dummy%ptr = 0. ! ok
  67   end subroutine
  68   pure subroutine test2(ptr)
  69     integer, pointer, intent(in) :: ptr
  70     !CHECK: error: Input variable 'ptr' is not definable
  71     !CHECK: because: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram
  72     read(internal,*) ptr
  73   end subroutine
  74   subroutine test3(objp, procp)
  75     real, intent(in), pointer :: objp
  76     procedure(sin), pointer, intent(in) :: procp
  77     !CHECK: error: Actual argument associated with INTENT(IN OUT) dummy argument 'op=' is not definable
  78     !CHECK: because: 'objp' is an INTENT(IN) dummy argument
  79     call test3a(objp)
  80     !CHECK: error: Actual argument associated with procedure pointer dummy argument 'pp=' may not be INTENT(IN)
  81     call test3b(procp)
  82   end subroutine
  83   subroutine test3a(op)
  84     real, intent(in out), pointer :: op
  85   end subroutine
  86   subroutine test3b(pp)
  87     procedure(sin), pointer, intent(in out) :: pp
  88   end subroutine
  89   subroutine test4(p)
  90     type(ptype), pointer, intent(in) :: p
  91     p%x = 1.
  92     p%ptr = 1. ! ok
  93     nullify(p%ptr) ! ok
  94     !CHECK: error: 'p' may not appear in NULLIFY
  95     !CHECK: because: 'p' is an INTENT(IN) dummy argument
  96     nullify(p)
  97   end
  98   subroutine test5(np)
  99     type(ptype), intent(in) :: np
 100     !CHECK: error: 'ptr' may not appear in NULLIFY
 101     !CHECK: because: 'np' is an INTENT(IN) dummy argument
 102     nullify(np%ptr)
 103   end
 104   pure function test6(lp)
 105     type(list), pointer :: lp
 106     !CHECK: error: The left-hand side of a pointer assignment is not definable
 107     !CHECK: because: 'lp' may not be defined in pure subprogram 'test6' because it is a POINTER dummy argument of a pure function
 108     lp%next%next => null()
 109   end
 110   pure subroutine test7(lp)
 111     type(list), pointer :: lp
 112     !CHECK-NOT: error:
 113     lp%next%next => null()
 114   end
 115 end module