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 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 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 161end module module1 162