flang/test/Semantics/call09.f90

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