flang/test/Semantics/structconst04.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   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
  41   type(has_pointer1) :: modulevar2
  42   type(has_pointer2) :: modulevar3
  43   type(has_pointer3) :: modulevar4
  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 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
  75     x2 = t2(modulevar2)
  76     !ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
  77     x3 = t3(modulevar3)
  78     !ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
  79     x4 = t4(modulevar4)
  80    contains
  81     pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
  82       real, target :: local1a
  83       type(t1) :: x1a
  84       type(t2) :: x2a
  85       type(t3) :: x3a
  86       type(t4) :: x4a
  87       real, intent(in), target :: dummy1a
  88       real, intent(inout), target :: dummy2a
  89       real, pointer :: dummy3a
  90       real, intent(inout), target :: dummy4a[*]
  91       x1a = t1(local1a)
  92       !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
  93       x1a = t1(usedfrom1)
  94       !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure
  95       x1a = t1(modulevar1)
  96       !ERROR: Externally visible object 'commonvar1' may not be associated with pointer component 'pt1' in a pure procedure
  97       x1a = t1(commonvar1)
  98       !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
  99       x1a = t1(dummy1)
 100       !ERROR: Externally visible object 'dummy1a' may not be associated with pointer component 'pt1' in a pure procedure
 101       x1a = t1(dummy1a)
 102       x1a = t1(dummy2a)
 103       x1a = t1(dummy3)
 104       x1a = t1(dummy3a)
 105 ! TODO when semantics handles coindexing:
 106 ! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
 107 ! TODO x1a = t1(dummy4a[0])
 108       x1a = t1(dummy4a)
 109       !ERROR: Externally visible object 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
 110       x2a = t2(modulevar2)
 111       !ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
 112       x3a = t3(modulevar3)
 113       !ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
 114       x4a = t4(modulevar4)
 115     end subroutine subr
 116   end subroutine
 117
 118   pure integer function pf1(dummy3)
 119     real, pointer :: dummy3
 120     type(t1) :: x1
 121     !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
 122     x1 = t1(dummy3)
 123    contains
 124     pure subroutine subr(dummy3a)
 125       real, pointer :: dummy3a
 126       type(t1) :: x1a
 127       !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
 128       x1a = t1(dummy3)
 129       x1a = t1(dummy3a)
 130     end subroutine
 131   end function
 132
 133   impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
 134     real, target :: local1
 135     type(t1) :: x1
 136     type(t2) :: x2
 137     type(t3) :: x3
 138     type(t4) :: x4
 139     real, intent(in), target :: dummy1
 140     real, intent(inout), target :: dummy2
 141     real, pointer :: dummy3
 142     real, intent(inout), target :: dummy4[*]
 143     real, target :: commonvar1
 144     common /cblock/ commonvar1
 145     ipf1 = 0.
 146     x1 = t1(local1)
 147     x1 = t1(usedfrom1)
 148     x1 = t1(modulevar1)
 149     x1 = t1(commonvar1)
 150     x1 = t1(dummy1)
 151     x1 = t1(dummy2)
 152     x1 = t1(dummy3)
 153 ! TODO when semantics handles coindexing:
 154 ! TODO x1 = t1(dummy4[0])
 155     x1 = t1(dummy4)
 156     x2 = t2(modulevar2)
 157     x3 = t3(modulevar3)
 158     x4 = t4(modulevar4)
 159   end function ipf1
 160 end module module1