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 s02b(p)
  26     procedure(real), pointer :: p
  27   end subroutine
  28   subroutine s03(p)
  29     procedure(realfunc) :: p
  30   end subroutine
  31   subroutine s04(p)
  32     !ERROR: A dummy procedure without the POINTER attribute may not have an INTENT attribute
  33     procedure(realfunc), intent(in) :: p
  34   end subroutine
  35   subroutine s05(p)
  36     procedure(realfunc), pointer, intent(in out) :: p
  37   end subroutine
  38
  39   subroutine selemental1(p)
  40     procedure(cos) :: p ! ok
  41   end subroutine
  42
  43   real elemental function elemfunc(x)
  44     real, intent(in) :: x
  45     elemfunc = x
  46   end function
  47   subroutine selemental2(p)
  48     !ERROR: A dummy procedure may not be ELEMENTAL
  49     procedure(elemfunc) :: p
  50   end subroutine
  51
  52   function procptr()
  53     procedure(realfunc), pointer :: procptr
  54     procptr => realfunc
  55   end function
  56   function intprocptr()
  57     procedure(intfunc), pointer :: intprocptr
  58     intprocptr => intfunc
  59   end function
  60
  61   subroutine test1 ! 15.5.2.9(5)
  62     intrinsic :: sin
  63     procedure(realfunc), pointer :: p
  64     procedure(intfunc), pointer :: ip
  65     integer, pointer :: intPtr
  66     p => realfunc
  67     ip => intfunc
  68     call s01(realfunc) ! ok
  69     !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
  70     call s01(intfunc)
  71     call s01(p) ! ok
  72     call s01(procptr()) ! ok
  73     !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
  74     call s01(intprocptr())
  75     call s01(null()) ! ok
  76     call s01(null(p)) ! ok
  77     !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
  78     call s01(null(ip))
  79     call s01(sin) ! ok
  80     !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure
  81     call s01(null(intPtr))
  82     !ERROR: Actual argument associated with procedure dummy argument 'p=' is typeless
  83     call s01(B"0101")
  84     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
  85     call s02(realfunc)
  86     call s02(p) ! ok
  87     !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
  88     call s02(ip)
  89     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
  90     call s02(procptr())
  91     call s02(null()) ! ok
  92     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
  93     call s05(null())
  94     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
  95     call s02(sin)
  96     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
  97     call s02b(realfunc)
  98     call s02b(p) ! ok
  99     !ERROR: Actual argument function associated with procedure dummy argument 'p=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
 100     call s02b(ip)
 101     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
 102     call s02b(procptr())
 103     call s02b(null())
 104     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
 105     call s02b(sin)
 106   end subroutine
 107
 108   subroutine callsub(s)
 109     call s
 110   end subroutine
 111   subroutine takesrealfunc1(f)
 112     external f
 113     real f
 114   end subroutine
 115   subroutine takesrealfunc2(f)
 116     x = f(1)
 117   end subroutine
 118   subroutine forwardproc(p)
 119     implicit none
 120     external :: p ! function or subroutine not known
 121     call foo(p)
 122   end subroutine
 123
 124   subroutine test2(unknown,ds,drf,dif) ! 15.5.2.9(2,3)
 125     external :: unknown, ds, drf, dif
 126     real :: drf
 127     integer :: dif
 128     procedure(callsub), pointer :: ps
 129     procedure(realfunc), pointer :: prf
 130     procedure(intfunc), pointer :: pif
 131     call ds ! now we know that's it's a subroutine
 132     call callsub(callsub) ! ok apart from infinite recursion
 133     call callsub(unknown) ! ok
 134     call callsub(ds) ! ok
 135     call callsub(ps) ! ok
 136     call takesrealfunc1(realfunc) ! ok
 137     call takesrealfunc1(unknown) ! ok
 138     call takesrealfunc1(drf) ! ok
 139     call takesrealfunc1(prf) ! ok
 140     call takesrealfunc2(realfunc) ! ok
 141     call takesrealfunc2(unknown) ! ok
 142     call takesrealfunc2(drf) ! ok
 143     call takesrealfunc2(prf) ! ok
 144     call forwardproc(callsub) ! ok
 145     call forwardproc(realfunc) ! ok
 146     call forwardproc(intfunc) ! ok
 147     call forwardproc(unknown) ! ok
 148     call forwardproc(ds) ! ok
 149     call forwardproc(drf) ! ok
 150     call forwardproc(dif) ! ok
 151     call forwardproc(ps) ! ok
 152     call forwardproc(prf) ! ok
 153     call forwardproc(pif) ! ok
 154     !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
 155     call callsub(realfunc)
 156     !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
 157     call callsub(intfunc)
 158     !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
 159     call callsub(drf)
 160     !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
 161     call callsub(dif)
 162     !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
 163     call callsub(prf)
 164     !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine
 165     call callsub(pif)
 166     !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
 167     call takesrealfunc1(callsub)
 168     !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
 169     call takesrealfunc1(ds)
 170     !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
 171     call takesrealfunc1(ps)
 172     !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
 173     call takesrealfunc1(intfunc)
 174     !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
 175     call takesrealfunc1(dif)
 176     !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
 177     call takesrealfunc1(pif)
 178     !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
 179     call takesrealfunc1(intfunc)
 180     !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
 181     call takesrealfunc2(callsub)
 182     !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
 183     call takesrealfunc2(ds)
 184     !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function
 185     call takesrealfunc2(ps)
 186     !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
 187     call takesrealfunc2(intfunc)
 188     !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
 189     call takesrealfunc2(dif)
 190     !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
 191     call takesrealfunc2(pif)
 192     !ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
 193     call takesrealfunc2(intfunc)
 194   end subroutine
 195 end module