202 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic2! Error tests for structure constructors: C1594 violations3! from assigning globally-visible data to POINTER components.4! test/Semantics/structconst04.f90 is this same test without type5! parameters.6 7module usefrom8 real, target :: usedfrom19end module usefrom10 11module module112 use usefrom13 implicit none14 type :: has_pointer115 real, pointer :: ptop16 type(has_pointer1), allocatable :: link1 ! don't loop during analysis17 end type has_pointer118 type :: has_pointer219 type(has_pointer1) :: pnested20 type(has_pointer2), allocatable :: link221 end type has_pointer222 type, extends(has_pointer2) :: has_pointer323 type(has_pointer3), allocatable :: link324 end type has_pointer325 type :: t1(k)26 integer, kind :: k27 real, pointer :: pt128 type(t1(k)), allocatable :: link29 end type t130 type :: t2(k)31 integer, kind :: k32 type(has_pointer1) :: hp133 type(t2(k)), allocatable :: link34 end type t235 type :: t3(k)36 integer, kind :: k37 type(has_pointer2) :: hp238 type(t3(k)), allocatable :: link39 end type t340 type :: t4(k)41 integer, kind :: k42 type(has_pointer3) :: hp343 type(t4(k)), allocatable :: link44 end type t445 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 contains51 52 pure subroutine ps1(dummy1, dummy2, dummy3, dummy4, co2, co3, co4)53 real, target :: local154 type(t1(0)) :: x155 type(t2(0)) :: x256 type(t3(0)) :: x357 type(t4(0)) :: x458 real, intent(in), target :: dummy159 real, intent(inout), target :: dummy260 real, pointer :: dummy361 real, intent(inout), target :: dummy4[*]62 real, target :: commonvar163 common /cblock/ commonvar164 type(has_pointer1), intent(in out) :: co2[*]65 type(has_pointer2), intent(in out) :: co3[*]66 type(has_pointer3), intent(in out) :: co4[*]67 x1 = t1(0)(local1)68 !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure69 x1 = t1(0)(usedfrom1)70 !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure71 x1 = t1(0)(modulevar1)72 !ERROR: Externally visible object 'cblock' may not be associated with pointer component 'pt1' in a pure procedure73 x1 = t1(0)(commonvar1)74 !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure75 x1 = t1(0)(dummy1)76 x1 = t1(0)(dummy2)77 x1 = t1(0)(dummy3)78! TODO when semantics handles coindexing:79! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure80! TODO x1 = t1(0)(dummy4[0])81 x1 = t1(0)(dummy4)82 !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure83 x2 = t2(0)(has_pointer1(modulevar1))84 !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure85 x3 = t3(0)(has_pointer2(has_pointer1(modulevar1)))86 !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure87 x4 = t4(0)(has_pointer3(has_pointer1(modulevar1)))88 !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'89 x2 = t2(0)(modulevar2)90 !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 '%pnested%ptop'91 x3 = t3(0)(modulevar3)92 !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 '%has_pointer2%pnested%ptop'93 x4 = t4(0)(modulevar4)94 !ERROR: A coindexed object may not be used in a pure procedure as the value for component 'hp1' which has the pointer component '%ptop'95 x2 = t2(0)(co2[1])96 !ERROR: A coindexed object may not be used in a pure procedure as the value for component 'hp2' which has the pointer component '%pnested%ptop'97 x3 = t3(0)(co3[1])98 !ERROR: A coindexed object may not be used in a pure procedure as the value for component 'hp3' which has the pointer component '%has_pointer2%pnested%ptop'99 x4 = t4(0)(co4[1])100 contains101 pure subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a, co2a, co3a, co4a)102 real, target :: local1a103 type(t1(0)) :: x1a104 type(t2(0)) :: x2a105 type(t3(0)) :: x3a106 type(t4(0)) :: x4a107 real, intent(in), target :: dummy1a108 real, intent(inout), target :: dummy2a109 real, pointer :: dummy3a110 real, intent(inout), target :: dummy4a[*]111 type(has_pointer1), intent(in out) :: co2a[*]112 type(has_pointer2), intent(in out) :: co3a[*]113 type(has_pointer3), intent(in out) :: co4a[*]114 x1a = t1(0)(local1a)115 !ERROR: Externally visible object 'usedfrom1' may not be associated with pointer component 'pt1' in a pure procedure116 x1a = t1(0)(usedfrom1)117 !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'pt1' in a pure procedure118 x1a = t1(0)(modulevar1)119 !ERROR: Externally visible object 'commonvar1' may not be associated with pointer component 'pt1' in a pure procedure120 x1a = t1(0)(commonvar1)121 !ERROR: Externally visible object 'dummy1' may not be associated with pointer component 'pt1' in a pure procedure122 x1a = t1(0)(dummy1)123 !ERROR: Externally visible object 'dummy1a' may not be associated with pointer component 'pt1' in a pure procedure124 x1a = t1(0)(dummy1a)125 x1a = t1(0)(dummy2a)126 x1a = t1(0)(dummy3)127 x1a = t1(0)(dummy3a)128! TODO when semantics handles coindexing:129! TODO !ERROR: Externally visible object may not be associated with a pointer in a pure procedure130! TODO x1a = t1(0)(dummy4a[0])131 x1a = t1(0)(dummy4a)132 !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure133 x2a = t2(0)(has_pointer1(modulevar1))134 !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure135 x3a = t3(0)(has_pointer2(has_pointer1(modulevar1)))136 !ERROR: Externally visible object 'modulevar1' may not be associated with pointer component 'ptop' in a pure procedure137 x4a = t4(0)(has_pointer3(has_pointer1(modulevar1)))138 !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'139 x2a = t2(0)(modulevar2)140 !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 '%pnested%ptop'141 x3a = t3(0)(modulevar3)142 !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 '%has_pointer2%pnested%ptop'143 x4a = t4(0)(modulevar4)144 !ERROR: A coindexed object may not be used in a pure procedure as the value for component 'hp1' which has the pointer component '%ptop'145 x2a = t2(0)(co2a[1])146 !ERROR: A coindexed object may not be used in a pure procedure as the value for component 'hp2' which has the pointer component '%pnested%ptop'147 x3a = t3(0)(co3a[1])148 !ERROR: A coindexed object may not be used in a pure procedure as the value for component 'hp3' which has the pointer component '%has_pointer2%pnested%ptop'149 x4a = t4(0)(co4a[1])150 end subroutine subr151 end subroutine152 153 pure integer function pf1(dummy3)154 real, pointer :: dummy3155 type(t1(0)) :: x1156 pf1 = 0157 !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure158 x1 = t1(0)(dummy3)159 contains160 pure subroutine subr(dummy3a)161 real, pointer :: dummy3a162 type(t1(0)) :: x1a163 !ERROR: Externally visible object 'dummy3' may not be associated with pointer component 'pt1' in a pure procedure164 x1a = t1(0)(dummy3)165 x1a = t1(0)(dummy3a)166 end subroutine167 end function168 169 impure real function ipf1(dummy1, dummy2, dummy3, dummy4)170 real, target :: local1171 type(t1(0)) :: x1172 type(t2(0)) :: x2173 type(t3(0)) :: x3174 type(t4(0)) :: x4175 real, intent(in), target :: dummy1176 real, intent(inout), target :: dummy2177 real, pointer :: dummy3178 real, intent(inout), target :: dummy4[*]179 real, target :: commonvar1180 common /cblock/ commonvar1181 ipf1 = 0.182 x1 = t1(0)(local1)183 x1 = t1(0)(usedfrom1)184 x1 = t1(0)(modulevar1)185 x1 = t1(0)(commonvar1)186 !WARNING: Pointer target is not a definable variable [-Wpointer-to-undefinable]187 !BECAUSE: 'dummy1' is an INTENT(IN) dummy argument188 x1 = t1(0)(dummy1)189 x1 = t1(0)(dummy2)190 x1 = t1(0)(dummy3)191! TODO when semantics handles coindexing:192! TODO x1 = t1(0)(dummy4[0])193 x1 = t1(0)(dummy4)194 x2 = t2(0)(has_pointer1(modulevar1))195 x3 = t3(0)(has_pointer2(has_pointer1(modulevar1)))196 x4 = t4(0)(has_pointer3(has_pointer1(modulevar1)))197 x2 = t2(0)(modulevar2)198 x3 = t3(0)(modulevar3)199 x4 = t4(0)(modulevar4)200 end function ipf1201end module module1202