238 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic2! Test 15.7 (C1583-C1590, C1592-C1599) constraints and restrictions3! for pure procedures.4! (C1591 is tested in call11.f90; C1594 in call12.f90.)5 6module m7 8 type :: impureFinal9 contains10 final :: impure11 end type12 type :: t13 end type14 type :: polyAlloc15 class(t), allocatable :: a16 end type17 18 real, volatile, target :: volatile19 20 interface21 ! Ensure no errors for "ignored" declarations in a pure interface.22 ! These declarations do not contribute to the characteristics of23 ! the procedure and must not elicit spurious errors about being used24 ! in a pure procedure.25 pure subroutine s05a26 import polyAlloc27 real, save :: v128 real :: v2 = 0.29 real :: v330 data v3/0./31 real :: v432 common /blk/ v433 save /blk/34 type(polyAlloc) :: v535 real, volatile :: v636 end subroutine37 end interface38 39 real :: moduleVar = 1.40 41 contains42 43 subroutine impure(x)44 type(impureFinal) :: x45 end subroutine46 integer impure function notpure(n)47 integer, value :: n48 notpure = n49 end function50 51 pure real function f01(a)52 real, intent(in) :: a ! ok53 end function54 pure real function f02(a)55 real, value :: a ! ok56 end function57 pure real function f03(a) ! C158358 !WARNING: non-POINTER dummy argument of pure function must have INTENT() or VALUE attribute59 real :: a60 end function61 pure real function f03a(a)62 real, pointer :: a ! ok63 end function64 pure real function f04(a) ! C158365 !WARNING: non-POINTER dummy argument of pure function should be INTENT(IN) or VALUE [-Wrelaxed-pure-dummy]66 real, intent(out) :: a67 end function68 pure real function f04a(a)69 real, pointer, intent(out) :: a ! ok if pointer70 end function71 pure real function f05(a) ! C158372 real, value :: a ! weird, but ok (VALUE without INTENT)73 end function74 pure function f06() ! C158475 !ERROR: Result of pure function may not have an impure FINAL subroutine76 type(impureFinal) :: f0677 end function78 pure function f07() ! C158579 !ERROR: Result of pure function may not be both polymorphic and ALLOCATABLE80 class(t), allocatable :: f0781 end function82 pure function f08() ! C158583 !ERROR: Result of pure function may not have polymorphic ALLOCATABLE potential component '%a'84 type(polyAlloc) :: f0885 end function86 87 pure subroutine s01(a) ! C158688 !WARNING: non-POINTER dummy argument of pure subroutine must have INTENT() or VALUE attribute89 real :: a90 end subroutine91 pure subroutine s01a(a)92 real, pointer :: a93 end subroutine94 pure subroutine s02(a) ! C158795 !ERROR: An INTENT(OUT) dummy argument of a pure subroutine may not have an impure FINAL subroutine96 type(impureFinal), intent(out) :: a97 end subroutine98 pure subroutine s03(a) ! C158899 !ERROR: An INTENT(OUT) dummy argument of a pure subroutine may not be polymorphic100 class(t), intent(out) :: a101 end subroutine102 pure subroutine s04(a) ! C1588103 !ERROR: An INTENT(OUT) dummy argument of a pure subroutine may not have a polymorphic ultimate component104 type(polyAlloc), intent(out) :: a105 end subroutine106 pure subroutine s05 ! C1589107 !ERROR: A pure subprogram may not have a variable with the SAVE attribute108 real, save :: v1109 !ERROR: A pure subprogram may not initialize a variable110 real :: v2 = 0.111 !ERROR: A pure subprogram may not initialize a variable112 real :: v3113 data v3/0./114 real :: v4115 common /blk/ v4116 block117 !ERROR: A pure subprogram may not have a variable with the SAVE attribute118 real, save :: v5119 !ERROR: A pure subprogram may not initialize a variable120 real :: v6 = 0.121 end block122 associate (x => moduleVar) ! ok123 end associate124 end subroutine125 pure subroutine s06 ! C1589126 !ERROR: A pure subprogram may not have a variable with the VOLATILE attribute127 real, volatile :: v1128 block129 !ERROR: A pure subprogram may not have a variable with the VOLATILE attribute130 real, volatile :: v2131 end block132 end subroutine133 pure subroutine s07(p) ! C1590134 !ERROR: A dummy procedure of a pure subprogram must be pure135 procedure(impure) :: p136 end subroutine137 ! C1591 is tested in call11.f90.138 pure subroutine s08 ! C1592139 contains140 pure subroutine pure ! ok141 end subroutine142 !ERROR: An internal subprogram of a pure subprogram must also be pure143 subroutine impure1144 end subroutine145 !ERROR: An internal subprogram of a pure subprogram must also be pure146 impure subroutine impure2147 end subroutine148 end subroutine149 pure subroutine s09 ! C1593150 real :: x151 !ERROR: VOLATILE variable 'volatile' may not be referenced in pure subprogram 's09'152 x = volatile153 end subroutine154 ! C1594 is tested in call12.f90.155 pure subroutine s10 ! C1595156 integer :: n157 !ERROR: Procedure 'notpure' referenced in pure subprogram 's10' must be pure too158 n = notpure(1)159 end subroutine160 pure subroutine s11(to) ! C1596161 ! Implicit deallocation at the end of the subroutine162 !ERROR: 'auto' may not be a local variable in a pure subprogram163 !BECAUSE: 'auto' has polymorphic component '%a' in a pure subprogram164 type(polyAlloc) :: auto165 type(polyAlloc), intent(in out) :: to166 !ERROR: Left-hand side of assignment is not definable167 !BECAUSE: 'to' has polymorphic component '%a' in a pure subprogram168 to = auto169 end subroutine170 pure subroutine s12171 character(20) :: buff172 real :: x173 write(buff, *) 1.0 ! ok174 read(buff, *) x ! ok175 !ERROR: External I/O is not allowed in a pure subprogram176 print *, 'hi' ! C1597177 !ERROR: External I/O is not allowed in a pure subprogram178 open(1, file='launch-codes') ! C1597179 !ERROR: External I/O is not allowed in a pure subprogram180 close(1) ! C1597181 !ERROR: External I/O is not allowed in a pure subprogram182 backspace(1) ! C1597183 !Also checks parsing of variant END FILE spelling184 !ERROR: External I/O is not allowed in a pure subprogram185 end file(1) ! C1597186 !ERROR: External I/O is not allowed in a pure subprogram187 rewind(1) ! C1597188 !ERROR: External I/O is not allowed in a pure subprogram189 flush(1) ! C1597190 !ERROR: External I/O is not allowed in a pure subprogram191 wait(1) ! C1597192 !ERROR: External I/O is not allowed in a pure subprogram193 inquire(1, name=buff) ! C1597194 !ERROR: External I/O is not allowed in a pure subprogram195 read(5, *) x ! C1598196 !ERROR: External I/O is not allowed in a pure subprogram197 read(*, *) x ! C1598198 !ERROR: External I/O is not allowed in a pure subprogram199 write(6, *) ! C1598200 !ERROR: External I/O is not allowed in a pure subprogram201 write(*, *) ! C1598202 end subroutine203 pure subroutine s13204 !ERROR: An image control statement may not appear in a pure subprogram205 sync all ! C1599206 end subroutine207 pure subroutine s14(i)208 integer :: img, nimgs, tmp209 integer, intent(in out) :: i[*]210 ! implicit sync all211 img = this_image()212 nimgs = num_images()213 i = img ! i is ready to use214 215 if ( img .eq. 1 ) then216 !ERROR: An image control statement may not appear in a pure subprogram217 sync images( nimgs ) ! explicit sync 1 with last img218 tmp = i[ nimgs ]219 !ERROR: An image control statement may not appear in a pure subprogram220 sync images( nimgs ) ! explicit sync 2 with last img221 i = tmp222 end if223 224 if ( img .eq. nimgs ) then225 !ERROR: An image control statement may not appear in a pure subprogram226 sync images( 1 ) ! explicit sync 1 with img 1227 tmp = i[ 1 ]228 !ERROR: An image control statement may not appear in a pure subprogram229 sync images( 1 ) ! explicit sync 2 with img 1230 i = tmp231 end if232 !ERROR: External I/O is not allowed in a pure subprogram233 write (*,*) img, i234 ! all other images wait here235 ! TODO others from 11.6.1 (many)236 end subroutine237end module238