flang/test/Semantics/call12.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Test 15.7 C1594 - prohibited assignments in pure subprograms
   3
   4 module used
   5   real :: useassociated
   6 end module
   7
   8 module m
   9   type :: t
  10     sequence
  11     real :: a
  12   end type
  13   type(t), target :: x
  14   type :: hasPtr
  15     real, pointer :: p
  16   end type
  17   type :: hasCoarray
  18     real, allocatable :: co[:]
  19   end type
  20   type :: hasHiddenPtr
  21     type(hasPtr), allocatable :: a
  22   end type
  23  contains
  24   integer pure function purefunc(x)
  25     integer, intent(in) :: x
  26     purefunc = x
  27   end function
  28   integer pure function f00(p0)
  29     procedure(purefunc) :: p0
  30     f00 = p0(1)
  31   end function
  32   pure function test(ptr, in, hpd, hhpd)
  33     use used
  34     type(t), pointer :: ptr, ptr2
  35     type(t), target, intent(in) :: in
  36     type(t), target :: y, z
  37     type(hasPtr) :: hp
  38     type(hasPtr), intent(in) :: hpd
  39     type(hasHiddenPtr) :: hhp
  40     type(hasHiddenPtr), intent(in) :: hhpd
  41     type(hasPtr), allocatable :: alloc
  42     type(hasHiddenPtr), allocatable :: hpAlloc
  43     type(hasCoarray), pointer :: hcp
  44     integer :: n
  45     common /block/ y
  46     external :: extfunc
  47     !ERROR: Left-hand side of assignment is not definable
  48     !BECAUSE: 'x' may not be defined in pure subprogram 'test' because it is host-associated
  49     x%a = 0.
  50     !ERROR: Left-hand side of assignment is not definable
  51     !BECAUSE: 'y' may not be defined in pure subprogram 'test' because it is in a COMMON block
  52     y%a = 0. ! C1594(1)
  53     !ERROR: Left-hand side of assignment is not definable
  54     !BECAUSE: 'useassociated' may not be defined in pure subprogram 'test' because it is USE-associated
  55     useassociated = 0.  ! C1594(1)
  56     !ERROR: Left-hand side of assignment is not definable
  57     !BECAUSE: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram
  58     ptr%a = 0. ! C1594(1)
  59     !ERROR: Left-hand side of assignment is not definable
  60     !BECAUSE: 'in' is an INTENT(IN) dummy argument
  61     in%a = 0. ! C1594(1)
  62     !ERROR: Left-hand side of assignment is not definable
  63     !BECAUSE: A pure subprogram may not define the coindexed object 'hcp%co[1_8]'
  64     hcp%co[1] = 0. ! C1594(1)
  65     !ERROR: The left-hand side of a pointer assignment is not definable
  66     !BECAUSE: 'ptr' may not be defined in pure subprogram 'test' because it is a POINTER dummy argument of a pure function
  67     ptr => z ! C1594(2)
  68     !ERROR: 'ptr' may not appear in NULLIFY
  69     !BECAUSE: 'ptr' may not be defined in pure subprogram 'test' because it is a POINTER dummy argument of a pure function
  70     nullify(ptr) ! C1594(2), 19.6.8
  71     !ERROR: A pure subprogram may not use 'ptr' as the target of pointer assignment because it is a POINTER dummy argument of a pure function
  72     ptr2 => ptr ! C1594(3)
  73     !ERROR: A pure subprogram may not use 'in' as the target of pointer assignment because it is an INTENT(IN) dummy argument
  74     ptr2 => in ! C1594(3)
  75     !ERROR: A pure subprogram may not use 'y' as the target of pointer assignment because it is in a COMMON block
  76     ptr2 => y ! C1594(2)
  77     !ERROR: Externally visible object 'block' may not be associated with pointer component 'p' in a pure procedure
  78     n = size([hasPtr(y%a)]) ! C1594(4)
  79     !ERROR: Externally visible object 'x' may not be associated with pointer component 'p' in a pure procedure
  80     n = size([hasPtr(x%a)]) ! C1594(4)
  81     !ERROR: Externally visible object 'ptr' may not be associated with pointer component 'p' in a pure procedure
  82     n = size([hasPtr(ptr%a)]) ! C1594(4)
  83     !ERROR: Externally visible object 'in' may not be associated with pointer component 'p' in a pure procedure
  84     n = size([hasPtr(in%a)]) ! C1594(4)
  85     !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER potential subobject component '%p'
  86     hp = hpd ! C1594(5)
  87     !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER potential subobject component '%p'
  88     allocate(alloc, source=hpd)
  89     !ERROR: A pure subprogram may not copy the value of 'hhpd' because it is an INTENT(IN) dummy argument and has the POINTER potential subobject component '%a%p'
  90     hhp = hhpd
  91     !ERROR: A pure subprogram may not copy the value of 'hhpd' because it is an INTENT(IN) dummy argument and has the POINTER potential subobject component '%a%p'
  92     allocate(hpAlloc, source=hhpd)
  93     !ERROR: Actual procedure argument for dummy argument 'p0=' of a PURE procedure must have an explicit interface
  94     n = f00(extfunc)
  95    contains
  96     pure subroutine internal
  97       type(hasPtr) :: localhp
  98       !ERROR: Left-hand side of assignment is not definable
  99       !BECAUSE: 'z' may not be defined in pure subprogram 'internal' because it is host-associated
 100       z%a = 0.
 101       !ERROR: Externally visible object 'z' may not be associated with pointer component 'p' in a pure procedure
 102       localhp = hasPtr(z%a)
 103     end subroutine
 104   end function
 105 end module