flang/test/Semantics/call10.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   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
   6 module 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     !ERROR: non-POINTER dummy argument of pure function must be INTENT(IN) or VALUE
  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     !ERROR: non-POINTER dummy argument of pure function must 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 ultimate component '%a'
  82     type(polyAlloc) :: f08
  83   end function
  84
  85   pure subroutine s01(a) ! C1586
  86     !ERROR: 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     !ERROR: A pure subprogram may not have a variable with the SAVE attribute
 113     real :: v4
 114     common /blk/ v4
 115     save /blk/
 116     block
 117     !ERROR: A pure subprogram may not have a variable with the SAVE attribute
 118       real, save :: v5
 119     !ERROR: A pure subprogram may not initialize a variable
 120       real :: v6 = 0.
 121     end block
 122   end subroutine
 123   pure subroutine s06 ! C1589
 124     !ERROR: A pure subprogram may not have a variable with the VOLATILE attribute
 125     real, volatile :: v1
 126     block
 127     !ERROR: A pure subprogram may not have a variable with the VOLATILE attribute
 128       real, volatile :: v2
 129     end block
 130   end subroutine
 131   pure subroutine s07(p) ! C1590
 132     !ERROR: A dummy procedure of a pure subprogram must be pure
 133     procedure(impure) :: p
 134   end subroutine
 135   ! C1591 is tested in call11.f90.
 136   pure subroutine s08 ! C1592
 137    contains
 138     pure subroutine pure ! ok
 139     end subroutine
 140     !ERROR: An internal subprogram of a pure subprogram must also be pure
 141     subroutine impure1
 142     end subroutine
 143     !ERROR: An internal subprogram of a pure subprogram must also be pure
 144     impure subroutine impure2
 145     end subroutine
 146   end subroutine
 147   pure subroutine s09 ! C1593
 148     real :: x
 149     !ERROR: VOLATILE variable 'volatile' may not be referenced in pure subprogram 's09'
 150     x = volatile
 151   end subroutine
 152   ! C1594 is tested in call12.f90.
 153   pure subroutine s10 ! C1595
 154     integer :: n
 155     !ERROR: Procedure 'notpure' referenced in pure subprogram 's10' must be pure too
 156     n = notpure(1)
 157   end subroutine
 158   pure subroutine s11(to) ! C1596
 159     ! Implicit deallocation at the end of the subroutine
 160     !ERROR: Deallocation of polymorphic object 'auto%a' is not permitted in a pure subprogram
 161     type(polyAlloc) :: auto
 162     type(polyAlloc), intent(in out) :: to
 163     !ERROR: Left-hand side of assignment is not definable
 164     !BECAUSE: 'to' has polymorphic non-coarray component '%a' in a pure subprogram
 165     to = auto
 166   end subroutine
 167   pure subroutine s12
 168     character(20) :: buff
 169     real :: x
 170     write(buff, *) 1.0 ! ok
 171     read(buff, *) x ! ok
 172     !ERROR: External I/O is not allowed in a pure subprogram
 173     print *, 'hi' ! C1597
 174     !ERROR: External I/O is not allowed in a pure subprogram
 175     open(1, file='launch-codes') ! C1597
 176     !ERROR: External I/O is not allowed in a pure subprogram
 177     close(1) ! C1597
 178     !ERROR: External I/O is not allowed in a pure subprogram
 179     backspace(1) ! C1597
 180     !Also checks parsing of variant END FILE spelling
 181     !ERROR: External I/O is not allowed in a pure subprogram
 182     end file(1) ! C1597
 183     !ERROR: External I/O is not allowed in a pure subprogram
 184     rewind(1) ! C1597
 185     !ERROR: External I/O is not allowed in a pure subprogram
 186     flush(1) ! C1597
 187     !ERROR: External I/O is not allowed in a pure subprogram
 188     wait(1) ! C1597
 189     !ERROR: External I/O is not allowed in a pure subprogram
 190     inquire(1, name=buff) ! C1597
 191     !ERROR: External I/O is not allowed in a pure subprogram
 192     read(5, *) x ! C1598
 193     !ERROR: External I/O is not allowed in a pure subprogram
 194     read(*, *) x ! C1598
 195     !ERROR: External I/O is not allowed in a pure subprogram
 196     write(6, *) ! C1598
 197     !ERROR: External I/O is not allowed in a pure subprogram
 198     write(*, *) ! C1598
 199   end subroutine
 200   pure subroutine s13
 201     !ERROR: An image control statement may not appear in a pure subprogram
 202     sync all ! C1599
 203   end subroutine
 204   pure subroutine s14
 205     integer :: img, nimgs, i[*], tmp
 206                                    ! implicit sync all
 207     img = this_image()
 208     nimgs = num_images()
 209     i = img                       ! i is ready to use
 210
 211     if ( img .eq. 1 ) then
 212       !ERROR: An image control statement may not appear in a pure subprogram
 213       sync images( nimgs )          ! explicit sync 1 with last img
 214       tmp = i[ nimgs ]
 215       !ERROR: An image control statement may not appear in a pure subprogram
 216       sync images( nimgs )          ! explicit sync 2 with last img
 217       i = tmp
 218     end if
 219
 220     if ( img .eq. nimgs ) then
 221       !ERROR: An image control statement may not appear in a pure subprogram
 222       sync images( 1 )              ! explicit sync 1 with img 1
 223       tmp = i[ 1 ]
 224       !ERROR: An image control statement may not appear in a pure subprogram
 225       sync images( 1 )              ! explicit sync 2 with img 1
 226       i = tmp
 227     end if
 228     !ERROR: External I/O is not allowed in a pure subprogram
 229     write (*,*) img, i
 230                                    ! all other images wait here
 231     ! TODO others from 11.6.1 (many)
 232   end subroutine
 233 end module