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