flang/test/Semantics/call10.f90

   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
   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     !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
 232 end module