1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic 2! Test 15.7 (C1583-C1590, C1592-C1599) constraints and restrictions 3! for pure procedures. 4! (C1591 is tested in call11.f90; C1594 in call12.f90.) 5 6module m 7 8 type :: impureFinal 9 contains 10 final :: impure 11 end type 12 type :: t 13 end type 14 type :: polyAlloc 15 class(t), allocatable :: a 16 end type 17 18 real, volatile, target :: volatile 19 20 interface 21 ! Ensure no errors for "ignored" declarations in a pure interface. 22 ! These declarations do not contribute to the characteristics of 23 ! the procedure and must not elicit spurious errors about being used 24 ! in a pure procedure. 25 pure subroutine s05a 26 import polyAlloc 27 real, save :: v1 28 real :: v2 = 0. 29 real :: v3 30 data v3/0./ 31 real :: v4 32 common /blk/ v4 33 save /blk/ 34 type(polyAlloc) :: v5 35 real, volatile :: v6 36 end subroutine 37 end interface 38 39 contains 40 41 subroutine impure(x) 42 type(impureFinal) :: x 43 end subroutine 44 integer impure function notpure(n) 45 integer, value :: n 46 notpure = n 47 end function 48 49 pure real function f01(a) 50 real, intent(in) :: a ! ok 51 end function 52 pure real function f02(a) 53 real, value :: a ! ok 54 end function 55 pure real function f03(a) ! C1583 56 !WARNING: non-POINTER dummy argument of pure function must have INTENT() or VALUE attribute 57 real :: a 58 end function 59 pure real function f03a(a) 60 real, pointer :: a ! ok 61 end function 62 pure real function f04(a) ! C1583 63 !WARNING: non-POINTER dummy argument of pure function should be INTENT(IN) or VALUE 64 real, intent(out) :: a 65 end function 66 pure real function f04a(a) 67 real, pointer, intent(out) :: a ! ok if pointer 68 end function 69 pure real function f05(a) ! C1583 70 real, value :: a ! weird, but ok (VALUE without INTENT) 71 end function 72 pure function f06() ! C1584 73 !ERROR: Result of pure function may not have an impure FINAL subroutine 74 type(impureFinal) :: f06 75 end function 76 pure function f07() ! C1585 77 !ERROR: Result of pure function may not be both polymorphic and ALLOCATABLE 78 class(t), allocatable :: f07 79 end function 80 pure function f08() ! C1585 81 !ERROR: Result of pure function may not have polymorphic ALLOCATABLE potential component '%a' 82 type(polyAlloc) :: f08 83 end function 84 85 pure subroutine s01(a) ! C1586 86 !WARNING: non-POINTER dummy argument of pure subroutine must have INTENT() or VALUE attribute 87 real :: a 88 end subroutine 89 pure subroutine s01a(a) 90 real, pointer :: a 91 end subroutine 92 pure subroutine s02(a) ! C1587 93 !ERROR: An INTENT(OUT) dummy argument of a pure subroutine may not have an impure FINAL subroutine 94 type(impureFinal), intent(out) :: a 95 end subroutine 96 pure subroutine s03(a) ! C1588 97 !ERROR: An INTENT(OUT) dummy argument of a pure subroutine may not be polymorphic 98 class(t), intent(out) :: a 99 end subroutine 100 pure subroutine s04(a) ! C1588 101 !ERROR: An INTENT(OUT) dummy argument of a pure subroutine may not have a polymorphic ultimate component 102 type(polyAlloc), intent(out) :: a 103 end subroutine 104 pure subroutine s05 ! C1589 105 !ERROR: A pure subprogram may not have a variable with the SAVE attribute 106 real, save :: v1 107 !ERROR: A pure subprogram may not initialize a variable 108 real :: v2 = 0. 109 !ERROR: A pure subprogram may not initialize a variable 110 real :: v3 111 data v3/0./ 112 real :: v4 113 common /blk/ v4 114 block 115 !ERROR: A pure subprogram may not have a variable with the SAVE attribute 116 real, save :: v5 117 !ERROR: A pure subprogram may not initialize a variable 118 real :: v6 = 0. 119 end block 120 end subroutine 121 pure subroutine s06 ! C1589 122 !ERROR: A pure subprogram may not have a variable with the VOLATILE attribute 123 real, volatile :: v1 124 block 125 !ERROR: A pure subprogram may not have a variable with the VOLATILE attribute 126 real, volatile :: v2 127 end block 128 end subroutine 129 pure subroutine s07(p) ! C1590 130 !ERROR: A dummy procedure of a pure subprogram must be pure 131 procedure(impure) :: p 132 end subroutine 133 ! C1591 is tested in call11.f90. 134 pure subroutine s08 ! C1592 135 contains 136 pure subroutine pure ! ok 137 end subroutine 138 !ERROR: An internal subprogram of a pure subprogram must also be pure 139 subroutine impure1 140 end subroutine 141 !ERROR: An internal subprogram of a pure subprogram must also be pure 142 impure subroutine impure2 143 end subroutine 144 end subroutine 145 pure subroutine s09 ! C1593 146 real :: x 147 !ERROR: VOLATILE variable 'volatile' may not be referenced in pure subprogram 's09' 148 x = volatile 149 end subroutine 150 ! C1594 is tested in call12.f90. 151 pure subroutine s10 ! C1595 152 integer :: n 153 !ERROR: Procedure 'notpure' referenced in pure subprogram 's10' must be pure too 154 n = notpure(1) 155 end subroutine 156 pure subroutine s11(to) ! C1596 157 ! Implicit deallocation at the end of the subroutine 158 !ERROR: 'auto' may not be a local variable in a pure subprogram 159 !BECAUSE: 'auto' has polymorphic component '%a' in a pure subprogram 160 type(polyAlloc) :: auto 161 type(polyAlloc), intent(in out) :: to 162 !ERROR: Left-hand side of assignment is not definable 163 !BECAUSE: 'to' has polymorphic component '%a' in a pure subprogram 164 to = auto 165 end subroutine 166 pure subroutine s12 167 character(20) :: buff 168 real :: x 169 write(buff, *) 1.0 ! ok 170 read(buff, *) x ! ok 171 !ERROR: External I/O is not allowed in a pure subprogram 172 print *, 'hi' ! C1597 173 !ERROR: External I/O is not allowed in a pure subprogram 174 open(1, file='launch-codes') ! C1597 175 !ERROR: External I/O is not allowed in a pure subprogram 176 close(1) ! C1597 177 !ERROR: External I/O is not allowed in a pure subprogram 178 backspace(1) ! C1597 179 !Also checks parsing of variant END FILE spelling 180 !ERROR: External I/O is not allowed in a pure subprogram 181 end file(1) ! C1597 182 !ERROR: External I/O is not allowed in a pure subprogram 183 rewind(1) ! C1597 184 !ERROR: External I/O is not allowed in a pure subprogram 185 flush(1) ! C1597 186 !ERROR: External I/O is not allowed in a pure subprogram 187 wait(1) ! C1597 188 !ERROR: External I/O is not allowed in a pure subprogram 189 inquire(1, name=buff) ! C1597 190 !ERROR: External I/O is not allowed in a pure subprogram 191 read(5, *) x ! C1598 192 !ERROR: External I/O is not allowed in a pure subprogram 193 read(*, *) x ! C1598 194 !ERROR: External I/O is not allowed in a pure subprogram 195 write(6, *) ! C1598 196 !ERROR: External I/O is not allowed in a pure subprogram 197 write(*, *) ! C1598 198 end subroutine 199 pure subroutine s13 200 !ERROR: An image control statement may not appear in a pure subprogram 201 sync all ! C1599 202 end subroutine 203 pure subroutine s14 204 integer :: img, nimgs, i[*], tmp 205 ! implicit sync all 206 img = this_image() 207 nimgs = num_images() 208 i = img ! i is ready to use 209 210 if ( img .eq. 1 ) then 211 !ERROR: An image control statement may not appear in a pure subprogram 212 sync images( nimgs ) ! explicit sync 1 with last img 213 tmp = i[ nimgs ] 214 !ERROR: An image control statement may not appear in a pure subprogram 215 sync images( nimgs ) ! explicit sync 2 with last img 216 i = tmp 217 end if 218 219 if ( img .eq. nimgs ) then 220 !ERROR: An image control statement may not appear in a pure subprogram 221 sync images( 1 ) ! explicit sync 1 with img 1 222 tmp = i[ 1 ] 223 !ERROR: An image control statement may not appear in a pure subprogram 224 sync images( 1 ) ! explicit sync 2 with img 1 225 i = tmp 226 end if 227 !ERROR: External I/O is not allowed in a pure subprogram 228 write (*,*) img, i 229 ! all other images wait here 230 ! TODO others from 11.6.1 (many) 231 end subroutine 232end module 233