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