flang/test/Semantics/call09.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Test 15.5.2.9(2,3,5) dummy procedure requirements
   3 ! C843
   4 !   An entity with the INTENT attribute shall be a dummy data object or a
   5 !   dummy procedure pointer.
   6
   7 module m
   8  contains
   9
  10   integer function intfunc(x)
  11     integer, intent(in) :: x
  12     intfunc = x
  13   end function
  14   real function realfunc(x)
  15     real, intent(in) :: x
  16     realfunc = x
  17   end function
  18
  19   subroutine s01(p)
  20     procedure(realfunc), pointer, intent(in) :: p
  21   end subroutine
  22   subroutine s02(p)
  23     procedure(realfunc), pointer :: p
  24   end subroutine
  25   subroutine s03(p)
  26     procedure(realfunc) :: p
  27   end subroutine
  28   subroutine s04(p)
  29     !ERROR: A dummy procedure without the POINTER attribute may not have an INTENT attribute
  30     procedure(realfunc), intent(in) :: p
  31   end subroutine
  32
  33   subroutine selemental1(p)
  34     procedure(cos) :: p ! ok
  35   end subroutine
  36
  37   real elemental function elemfunc(x)
  38     real, intent(in) :: x
  39     elemfunc = x
  40   end function
  41   subroutine selemental2(p)
  42     !ERROR: A dummy procedure may not be ELEMENTAL
  43     procedure(elemfunc) :: p
  44   end subroutine
  45
  46   function procptr()
  47     procedure(realfunc), pointer :: procptr
  48     procptr => realfunc
  49   end function
  50   function intprocptr()
  51     procedure(intfunc), pointer :: intprocptr
  52     intprocptr => intfunc
  53   end function
  54
  55   subroutine test1 ! 15.5.2.9(5)
  56     intrinsic :: sin
  57     procedure(realfunc), pointer :: p
  58     procedure(intfunc), pointer :: ip
  59     integer, pointer :: intPtr
  60     p => realfunc
  61     ip => intfunc
  62     call s01(realfunc) ! ok
  63     !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p='
  64     call s01(intfunc)
  65     call s01(p) ! ok
  66     call s01(procptr()) ! ok
  67     !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p='
  68     call s01(intprocptr())
  69     call s01(null()) ! ok
  70     call s01(null(p)) ! ok
  71     !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p='
  72     call s01(null(ip))
  73     call s01(sin) ! ok
  74     !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure
  75     call s01(null(intPtr))
  76     !ERROR: Actual argument associated with procedure dummy argument 'p=' is typeless
  77     call s01(B"0101")
  78     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
  79     call s02(realfunc)
  80     call s02(p) ! ok
  81     !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p='
  82     call s02(ip)
  83     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
  84     call s02(procptr())
  85     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
  86     call s02(null())
  87     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
  88     call s02(null(p))
  89     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
  90     call s02(sin)
  91   end subroutine
  92
  93   subroutine callsub(s)
  94     call s
  95   end subroutine
  96   subroutine takesrealfunc1(f)
  97     external f
  98     real f
  99   end subroutine
 100   subroutine takesrealfunc2(f)
 101     x = f(1)
 102   end subroutine
 103   subroutine forwardproc(p)
 104     implicit none
 105     external :: p ! function or subroutine not known
 106     call foo(p)
 107   end subroutine
 108
 109   subroutine test2(unknown,ds,drf,dif) ! 15.5.2.9(2,3)
 110     external :: unknown, ds, drf, dif
 111     real :: drf
 112     integer :: dif
 113     procedure(callsub), pointer :: ps
 114     procedure(realfunc), pointer :: prf
 115     procedure(intfunc), pointer :: pif
 116     call ds ! now we know that's it's a subroutine
 117     call callsub(callsub) ! ok apart from infinite recursion
 118     call callsub(unknown) ! ok
 119     call callsub(ds) ! ok
 120     call callsub(ps) ! ok
 121     call takesrealfunc1(realfunc) ! ok
 122     call takesrealfunc1(unknown) ! ok
 123     call takesrealfunc1(drf) ! ok
 124     call takesrealfunc1(prf) ! ok
 125     call takesrealfunc2(realfunc) ! ok
 126     call takesrealfunc2(unknown) ! ok
 127     call takesrealfunc2(drf) ! ok
 128     call takesrealfunc2(prf) ! ok
 129     call forwardproc(callsub) ! ok
 130     call forwardproc(realfunc) ! ok
 131     call forwardproc(intfunc) ! ok
 132     call forwardproc(unknown) ! ok
 133     call forwardproc(ds) ! ok
 134     call forwardproc(drf) ! ok
 135     call forwardproc(dif) ! ok
 136     call forwardproc(ps) ! ok
 137     call forwardproc(prf) ! ok
 138     call forwardproc(pif) ! ok
 139     !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
 140     call callsub(realfunc)
 141     !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
 142     call callsub(intfunc)
 143     !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
 144     call callsub(drf)
 145     !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
 146     call callsub(dif)
 147     !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
 148     call callsub(prf)
 149     !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
 150     call callsub(pif)
 151     !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
 152     call takesrealfunc1(callsub)
 153     !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
 154     call takesrealfunc1(ds)
 155     !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
 156     call takesrealfunc1(ps)
 157     !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
 158     call takesrealfunc1(intfunc)
 159     !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
 160     call takesrealfunc1(dif)
 161     !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
 162     call takesrealfunc1(pif)
 163     !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
 164     call takesrealfunc1(intfunc)
 165     !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
 166     call takesrealfunc2(callsub)
 167     !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
 168     call takesrealfunc2(ds)
 169     !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
 170     call takesrealfunc2(ps)
 171     !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
 172     call takesrealfunc2(intfunc)
 173     !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
 174     call takesrealfunc2(dif)
 175     !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
 176     call takesrealfunc2(pif)
 177     !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
 178     call takesrealfunc2(intfunc)
 179   end subroutine
 180 end module