flang/test/Semantics/structconst04.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
   2 ! Error tests for structure constructors: C1594 violations
   3 ! from assigning globally-visible data to POINTER components.
   4 ! This test is structconst03.f90 with the type parameters removed.
   5
   6 module usefrom
   7   real, target :: usedfrom1
   8 end module usefrom
   9
  10 module module1
  11   use usefrom
  12   implicit none
  13   type :: has_pointer1
  14     real, pointer :: ptop
  15     type(has_pointer1), allocatable :: link1 ! don't loop during analysis
  16   end type has_pointer1
  17   type :: has_pointer2
  18     type(has_pointer1) :: pnested
  19     type(has_pointer2), allocatable :: link2
  20   end type has_pointer2
  21   type, extends(has_pointer2) :: has_pointer3
  22     type(has_pointer3), allocatable :: link3
  23   end type has_pointer3
  24   type :: t1
  25     real, pointer :: pt1
  26     type(t1), allocatable :: link
  27   end type t1
  28   type :: t2
  29     type(has_pointer1) :: hp1
  30     type(t2), allocatable :: link
  31   end type t2
  32   type :: t3
  33     type(has_pointer2) :: hp2
  34     type(t3), allocatable :: link
  35   end type t3
  36   type :: t4
  37     type(has_pointer3) :: hp3
  38     type(t4), allocatable :: link
  39   end type t4
  40   real, target :: modulevar1 = 0.
  41   type(has_pointer1) :: modulevar2 = has_pointer1(modulevar1)
  42   type(has_pointer2) :: modulevar3 = has_pointer2(has_pointer1(modulevar1))
  43   type(has_pointer3) :: modulevar4 = has_pointer3(has_pointer1(modulevar1))
  44
  45  contains
  46
  47   pure subroutine ps1(dummy1, dummy2, dummy3, dummy4)
  48     real, target :: local1
  49     type(t1) :: x1
  50     type(t2) :: x2
  51     type(t3) :: x3
  52     type(t4) :: x4
  53     real, intent(in), target :: dummy1
  54     real, intent(inout), target :: dummy2
  55     real, pointer :: dummy3
  56     real, intent(inout), target :: dummy4[*]
  57     real, target :: commonvar1
  58     common /cblock/ commonvar1
  59     x1 = t1(local1)
  60     !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
  61     x1 = t1(usedfrom1)
  62     !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure
  63     x1 = t1(modulevar1)
  64     !ERROR: Externally visible object 'cblock' may not be associated with pointer component 'pt1' in a pure procedure
  65     x1 = t1(commonvar1)
  66     !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
  67     x1 = t1(dummy1)
  68     x1 = t1(dummy2)
  69     x1 = t1(dummy3)
  70 ! TODO when semantics handles coindexing:
  71 ! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
  72 ! TODO x1 = t1(dummy4[0])
  73     x1 = t1(dummy4)
  74     !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
  75     x2 = t2(has_pointer1(modulevar1))
  76     !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
  77     x3 = t3(has_pointer2(has_pointer1(modulevar1)))
  78     !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
  79     x4 = t4(has_pointer3(has_pointer1(modulevar1)))
  80     !ERROR: The externally visible object 'modulevar2' may not be used in a pure procedure as the value for component 'hp1' which has the pointer component 'ptop'
  81     x2 = t2(modulevar2)
  82     !ERROR: The externally visible object 'modulevar3' may not be used in a pure procedure as the value for component 'hp2' which has the pointer component 'ptop'
  83     x3 = t3(modulevar3)
  84     !ERROR: The externally visible object 'modulevar4' may not be used in a pure procedure as the value for component 'hp3' which has the pointer component 'ptop'
  85     x4 = t4(modulevar4)
  86    contains
  87     pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
  88       real, target :: local1a
  89       type(t1) :: x1a
  90       type(t2) :: x2a
  91       type(t3) :: x3a
  92       type(t4) :: x4a
  93       real, intent(in), target :: dummy1a
  94       real, intent(inout), target :: dummy2a
  95       real, pointer :: dummy3a
  96       real, intent(inout), target :: dummy4a[*]
  97       x1a = t1(local1a)
  98       !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
  99       x1a = t1(usedfrom1)
 100       !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure
 101       x1a = t1(modulevar1)
 102       !ERROR: Externally visible object 'commonvar1' may not be associated with pointer component 'pt1' in a pure procedure
 103       x1a = t1(commonvar1)
 104       !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
 105       x1a = t1(dummy1)
 106       !ERROR: Externally visible object 'dummy1a' may not be associated with pointer component 'pt1' in a pure procedure
 107       x1a = t1(dummy1a)
 108       x1a = t1(dummy2a)
 109       x1a = t1(dummy3)
 110       x1a = t1(dummy3a)
 111 ! TODO when semantics handles coindexing:
 112 ! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
 113 ! TODO x1a = t1(dummy4a[0])
 114       x1a = t1(dummy4a)
 115       !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
 116       x2a = t2(has_pointer1(modulevar1))
 117       !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
 118       x3a = t3(has_pointer2(has_pointer1(modulevar1)))
 119       !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure
 120       x4a = t4(has_pointer3(has_pointer1(modulevar1)))
 121       !ERROR: The externally visible object 'modulevar2' may not be used in a pure procedure as the value for component 'hp1' which has the pointer component 'ptop'
 122       x2a = t2(modulevar2)
 123       !ERROR: The externally visible object 'modulevar3' may not be used in a pure procedure as the value for component 'hp2' which has the pointer component 'ptop'
 124       x3a = t3(modulevar3)
 125       !ERROR: The externally visible object 'modulevar4' may not be used in a pure procedure as the value for component 'hp3' which has the pointer component 'ptop'
 126       x4a = t4(modulevar4)
 127     end subroutine subr
 128   end subroutine
 129
 130   pure integer function pf1(dummy3)
 131     real, pointer :: dummy3
 132     type(t1) :: x1
 133     !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
 134     x1 = t1(dummy3)
 135    contains
 136     pure subroutine subr(dummy3a)
 137       real, pointer :: dummy3a
 138       type(t1) :: x1a
 139       !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
 140       x1a = t1(dummy3)
 141       x1a = t1(dummy3a)
 142     end subroutine
 143   end function
 144
 145   impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
 146     real, target :: local1
 147     type(t1) :: x1
 148     type(t2) :: x2
 149     type(t3) :: x3
 150     type(t4) :: x4
 151     real, intent(in), target :: dummy1
 152     real, intent(inout), target :: dummy2
 153     real, pointer :: dummy3
 154     real, intent(inout), target :: dummy4[*]
 155     real, target :: commonvar1
 156     common /cblock/ commonvar1
 157     ipf1 = 0.
 158     x1 = t1(local1)
 159     x1 = t1(usedfrom1)
 160     x1 = t1(modulevar1)
 161     x1 = t1(commonvar1)
 162     !WARNING: Pointer target is not a definable variable
 163     !BECAUSE: 'dummy1' is an INTENT(IN) dummy argument
 164     x1 = t1(dummy1)
 165     x1 = t1(dummy2)
 166     x1 = t1(dummy3)
 167 ! TODO when semantics handles coindexing:
 168 ! TODO x1 = t1(dummy4[0])
 169     x1 = t1(dummy4)
 170     x2 = t2(has_pointer1(modulevar1))
 171     x3 = t3(has_pointer2(has_pointer1(modulevar1)))
 172     x4 = t4(has_pointer3(has_pointer1(modulevar1)))
 173     x2 = t2(modulevar2)
 174     x3 = t3(modulevar3)
 175     x4 = t4(modulevar4)
 176   end function ipf1
 177 end module module1