flang/test/Semantics/call02.f90

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