flang/test/Semantics/structconst04.f90

   1 ! RUN: %S/test_errors.sh %s %t %flang_fc1
   2 ! REQUIRES: shell
   3 ! Error tests for structure constructors: C1594 violations
   4 ! from assigning globally-visible data to POINTER components.
   5 ! This test is structconst03.f90 with the type parameters removed.
   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
  26     real, pointer :: pt1
  27     type(t1), allocatable :: link
  28   end type t1
  29   type :: t2
  30     type(has_pointer1) :: hp1
  31     type(t2), allocatable :: link
  32   end type t2
  33   type :: t3
  34     type(has_pointer2) :: hp2
  35     type(t3), allocatable :: link
  36   end type t3
  37   type :: t4
  38     type(has_pointer3) :: hp3
  39     type(t4), allocatable :: link
  40   end type t4
  41   real, target :: modulevar1
  42   type(has_pointer1) :: modulevar2
  43   type(has_pointer2) :: modulevar3
  44   type(has_pointer3) :: modulevar4
  45
  46  contains
  47
  48   pure subroutine ps1(dummy1, dummy2, dummy3, dummy4)
  49     real, target :: local1
  50     type(t1) :: x1
  51     type(t2) :: x2
  52     type(t3) :: x3
  53     type(t4) :: x4
  54     real, intent(in), target :: dummy1
  55     real, intent(inout), target :: dummy2
  56     real, pointer :: dummy3
  57     real, intent(inout), target :: dummy4[*]
  58     real, target :: commonvar1
  59     common /cblock/ commonvar1
  60     x1 = t1(local1)
  61     !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
  62     x1 = t1(usedfrom1)
  63     !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure
  64     x1 = t1(modulevar1)
  65     !ERROR: Externally visible object 'cblock' may not be associated with pointer component 'pt1' in a pure procedure
  66     x1 = t1(commonvar1)
  67     !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
  68     x1 = t1(dummy1)
  69     x1 = t1(dummy2)
  70     x1 = t1(dummy3)
  71 ! TODO when semantics handles coindexing:
  72 ! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
  73 ! TODO x1 = t1(dummy4[0])
  74     x1 = t1(dummy4)
  75     !ERROR: Externally visible object 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
  76     x2 = t2(modulevar2)
  77     !ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
  78     x3 = t3(modulevar3)
  79     !ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
  80     x4 = t4(modulevar4)
  81    contains
  82     pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
  83       real, target :: local1a
  84       type(t1) :: x1a
  85       type(t2) :: x2a
  86       type(t3) :: x3a
  87       type(t4) :: x4a
  88       real, intent(in), target :: dummy1a
  89       real, intent(inout), target :: dummy2a
  90       real, pointer :: dummy3a
  91       real, intent(inout), target :: dummy4a[*]
  92       x1a = t1(local1a)
  93       !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure
  94       x1a = t1(usedfrom1)
  95       !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure
  96       x1a = t1(modulevar1)
  97       !ERROR: Externally visible object 'commonvar1' may not be associated with pointer component 'pt1' in a pure procedure
  98       x1a = t1(commonvar1)
  99       !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure
 100       x1a = t1(dummy1)
 101       !ERROR: Externally visible object 'dummy1a' may not be associated with pointer component 'pt1' in a pure procedure
 102       x1a = t1(dummy1a)
 103       x1a = t1(dummy2a)
 104       x1a = t1(dummy3)
 105       x1a = t1(dummy3a)
 106 ! TODO when semantics handles coindexing:
 107 ! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure
 108 ! TODO x1a = t1(dummy4a[0])
 109       x1a = t1(dummy4a)
 110       !ERROR: Externally visible object 'modulevar2' may not be associated with pointer component 'ptop' in a pure procedure
 111       x2a = t2(modulevar2)
 112       !ERROR: Externally visible object 'modulevar3' may not be associated with pointer component 'ptop' in a pure procedure
 113       x3a = t3(modulevar3)
 114       !ERROR: Externally visible object 'modulevar4' may not be associated with pointer component 'ptop' in a pure procedure
 115       x4a = t4(modulevar4)
 116     end subroutine subr
 117   end subroutine
 118
 119   pure integer function pf1(dummy3)
 120     real, pointer :: dummy3
 121     type(t1) :: x1
 122     !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
 123     x1 = t1(dummy3)
 124    contains
 125     pure subroutine subr(dummy3a)
 126       real, pointer :: dummy3a
 127       type(t1) :: x1a
 128       !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure
 129       x1a = t1(dummy3)
 130       x1a = t1(dummy3a)
 131     end subroutine
 132   end function
 133
 134   impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
 135     real, target :: local1
 136     type(t1) :: x1
 137     type(t2) :: x2
 138     type(t3) :: x3
 139     type(t4) :: x4
 140     real, intent(in), target :: dummy1
 141     real, intent(inout), target :: dummy2
 142     real, pointer :: dummy3
 143     real, intent(inout), target :: dummy4[*]
 144     real, target :: commonvar1
 145     common /cblock/ commonvar1
 146     ipf1 = 0.
 147     x1 = t1(local1)
 148     x1 = t1(usedfrom1)
 149     x1 = t1(modulevar1)
 150     x1 = t1(commonvar1)
 151     x1 = t1(dummy1)
 152     x1 = t1(dummy2)
 153     x1 = t1(dummy3)
 154 ! TODO when semantics handles coindexing:
 155 ! TODO x1 = t1(dummy4[0])
 156     x1 = t1(dummy4)
 157     x2 = t2(modulevar2)
 158     x3 = t3(modulevar3)
 159     x4 = t4(modulevar4)
 160   end function ipf1
 161 end module module1