flang/test/Semantics/call02.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! 15.5.1 procedure reference constraints and restrictions
   3
   4 subroutine s01(elem, subr)
   5   interface
   6     !ERROR: A dummy procedure may not be ELEMENTAL
   7     elemental real function elem(x)
   8       real, intent(in), value :: x
   9     end function
  10     subroutine subr(dummy)
  11       procedure(sin) :: dummy
  12     end subroutine
  13     subroutine badsubr(dummy)
  14       import :: elem
  15       !ERROR: A dummy procedure may not be ELEMENTAL
  16       procedure(elem) :: dummy
  17     end subroutine
  18     subroutine optionalsubr(dummy)
  19       procedure(sin), optional :: dummy
  20     end subroutine
  21     subroutine ptrsubr(dummy)
  22       procedure(sin), pointer, intent(in) :: dummy
  23     end subroutine
  24   end interface
  25   intrinsic :: cos
  26   call subr(cos) ! not an error
  27   !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument
  28   call subr(elem) ! C1533
  29   !ERROR: Actual argument associated with procedure dummy argument 'dummy=' is a null pointer
  30   call subr(null())
  31   call optionalsubr(null()) ! ok
  32   call ptrsubr(null()) ! ok
  33   !ERROR: Actual argument associated with procedure dummy argument 'dummy=' is typeless
  34   call subr(B"1010")
  35 end subroutine
  36
  37 subroutine s02
  38   !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument
  39   call sub(elem)
  40  contains
  41   elemental integer function elem()
  42     elem = 1
  43   end function
  44 end
  45
  46 subroutine s03
  47   interface
  48     subroutine sub1(p)
  49       procedure(real) :: p
  50     end subroutine
  51   end interface
  52   sf(x) = x + 1.
  53   !ERROR: Statement function 'sf' may not be passed as an actual argument
  54   call sub1(sf)
  55   !ERROR: Statement function 'sf' may not be passed as an actual argument
  56   call sub2(sf)
  57 end
  58
  59 module m01
  60   procedure(sin) :: elem01
  61   interface
  62     elemental real function elem02(x)
  63       real, value :: x
  64     end function
  65     subroutine callme(f)
  66       external f
  67     end subroutine
  68   end interface
  69  contains
  70   elemental real function elem03(x)
  71     real, value :: x
  72   end function
  73   subroutine test
  74     intrinsic :: cos
  75     call callme(cos) ! not an error
  76     !ERROR: Non-intrinsic ELEMENTAL procedure 'elem01' may not be passed as an actual argument
  77     call callme(elem01) ! C1533
  78     !ERROR: Non-intrinsic ELEMENTAL procedure 'elem02' may not be passed as an actual argument
  79     call callme(elem02) ! C1533
  80     !ERROR: Non-intrinsic ELEMENTAL procedure 'elem03' may not be passed as an actual argument
  81     call callme(elem03) ! C1533
  82     !ERROR: Non-intrinsic ELEMENTAL procedure 'elem04' may not be passed as an actual argument
  83     call callme(elem04) ! C1533
  84    contains
  85     elemental real function elem04(x)
  86       real, value :: x
  87     end function
  88   end subroutine
  89 end module
  90
  91 module m02
  92   type :: t
  93     integer, pointer :: ptr
  94   end type
  95   type(t) :: coarray[*]
  96  contains
  97   subroutine callee(x)
  98     type(t), intent(in) :: x
  99   end subroutine
 100   subroutine test
 101     !ERROR: Coindexed object 'coarray' with POINTER ultimate component '%ptr' cannot be associated with dummy argument 'x='
 102     call callee(coarray[1]) ! C1537
 103   end subroutine
 104 end module
 105
 106 module m03
 107  contains
 108   subroutine test
 109     !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument
 110     call sub(elem)
 111    contains
 112     elemental integer function elem()
 113       elem = 1
 114     end function
 115   end
 116 end
 117
 118 program p03
 119   logical :: l
 120   call s1(index)
 121   l = index .eq. 0  ! index is an object entity, not an intrinsic
 122   call s2(sin)
 123   !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure
 124   call s3(cos)
 125 contains
 126   subroutine s2(x)
 127     real :: x
 128   end
 129   subroutine s3(p)
 130     procedure(real) :: p
 131   end
 132 end
 133
 134 subroutine p04
 135   implicit none
 136   !ERROR: No explicit type declared for 'index'
 137   call s1(index)
 138 end
 139
 140 subroutine p05
 141   integer :: a1(2), a2, a3
 142   !ERROR: In an elemental procedure reference with at least one array argument, actual argument a2 that corresponds to an INTENT(OUT) or INTENT(INOUT) dummy argument must be an array
 143   !ERROR: In an elemental procedure reference with at least one array argument, actual argument a3 that corresponds to an INTENT(OUT) or INTENT(INOUT) dummy argument must be an array
 144   call s1(a1, a2, a3)
 145 contains
 146   elemental subroutine s1(a, b, c)
 147     integer, intent(in) :: a
 148     integer, intent(out) :: b
 149     integer, intent(inout) :: c
 150     b = a
 151     c = a
 152   end
 153 end