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