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  contains
  21   integer pure function purefunc(x)
  22     integer, intent(in) :: x
  23     purefunc = x
  24   end function
  25   integer pure function f00(p0)
  26     procedure(purefunc) :: p0
  27     f00 = p0(1)
  28   end function
  29   pure function test(ptr, in, hpd)
  30     use used
  31     type(t), pointer :: ptr, ptr2
  32     type(t), target, intent(in) :: in
  33     type(t), target :: y, z
  34     type(hasPtr) :: hp
  35     type(hasPtr), intent(in) :: hpd
  36     type(hasPtr), allocatable :: alloc
  37     type(hasCoarray), pointer :: hcp
  38     integer :: n
  39     common /block/ y
  40     external :: extfunc
  41     !ERROR: Pure subprogram 'test' may not define 'x' because it is host-associated
  42     x%a = 0.
  43     !ERROR: Pure subprogram 'test' may not define 'y' because it is in a COMMON block
  44     y%a = 0. ! C1594(1)
  45     !ERROR: Pure subprogram 'test' may not define 'useassociated' because it is USE-associated
  46     useassociated = 0.  ! C1594(1)
  47     !ERROR: Pure subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a pure function
  48     ptr%a = 0. ! C1594(1)
  49     !ERROR: Pure subprogram 'test' may not define 'in' because it is an INTENT(IN) dummy argument
  50     in%a = 0. ! C1594(1)
  51     !ERROR: A pure subprogram may not define a coindexed object
  52     hcp%co[1] = 0. ! C1594(1)
  53     !ERROR: Pure subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a pure function
  54     ptr => z ! C1594(2)
  55     !ERROR: Pure subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a pure function
  56     nullify(ptr) ! C1594(2), 19.6.8
  57     !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
  58     ptr2 => ptr ! C1594(3)
  59     !ERROR: A pure subprogram may not use 'in' as the target of pointer assignment because it is an INTENT(IN) dummy argument
  60     ptr2 => in ! C1594(3)
  61     !ERROR: A pure subprogram may not use 'y' as the target of pointer assignment because it is in a COMMON block
  62     ptr2 => y ! C1594(2)
  63     !ERROR: Externally visible object 'block' may not be associated with pointer component 'p' in a pure procedure
  64     n = size([hasPtr(y%a)]) ! C1594(4)
  65     !ERROR: Externally visible object 'x' may not be associated with pointer component 'p' in a pure procedure
  66     n = size([hasPtr(x%a)]) ! C1594(4)
  67     !ERROR: Externally visible object 'ptr' may not be associated with pointer component 'p' in a pure procedure
  68     n = size([hasPtr(ptr%a)]) ! C1594(4)
  69     !ERROR: Externally visible object 'in' may not be associated with pointer component 'p' in a pure procedure
  70     n = size([hasPtr(in%a)]) ! C1594(4)
  71     !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER component '%p'
  72     hp = hpd ! C1594(5)
  73     !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER component '%p'
  74     allocate(alloc, source=hpd)
  75     !ERROR: Actual procedure argument for dummy argument 'p0=' of a PURE procedure must have an explicit interface
  76     n = f00(extfunc)
  77    contains
  78     pure subroutine internal
  79       type(hasPtr) :: localhp
  80       !ERROR: Pure subprogram 'internal' may not define 'z' because it is host-associated
  81       z%a = 0.
  82       !ERROR: Externally visible object 'z' may not be associated with pointer component 'p' in a pure procedure
  83       localhp = hasPtr(z%a)
  84     end subroutine
  85   end function
  86 end module