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       !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   end function
  76   subroutine test
  77     intrinsic :: cos
  78     call callme(cos) ! not an error
  79     !ERROR: Non-intrinsic ELEMENTAL procedure 'elem01' may not be passed as an actual argument
  80     call callme(elem01) ! C1533
  81     !ERROR: Non-intrinsic ELEMENTAL procedure 'elem02' may not be passed as an actual argument
  82     call callme(elem02) ! C1533
  83     !ERROR: Non-intrinsic ELEMENTAL procedure 'elem03' may not be passed as an actual argument
  84     call callme(elem03) ! C1533
  85     !ERROR: Non-intrinsic ELEMENTAL procedure 'elem04' may not be passed as an actual argument
  86     call callme(elem04) ! C1533
  87    contains
  88     elemental real function elem04(x)
  89       real, value :: x
  90     end function
  91   end subroutine
  92 end module
  93
  94 module m02
  95   type :: t
  96     integer, pointer :: ptr
  97   end type
  98   type(t) :: coarray[*]
  99  contains
 100   subroutine callee(x)
 101     type(t), intent(in) :: x
 102   end subroutine
 103   subroutine test
 104     !ERROR: Coindexed object 'coarray' with POINTER ultimate component '%ptr' cannot be associated with dummy argument 'x='
 105     call callee(coarray[1]) ! C1537
 106   end subroutine
 107 end module
 108
 109 module m03
 110  contains
 111   subroutine test
 112     !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument
 113     call sub(elem)
 114    contains
 115     elemental integer function elem()
 116       elem = 1
 117     end function
 118   end
 119 end
 120
 121 program p03
 122   logical :: l
 123   call s1(index)
 124   l = index .eq. 0  ! index is an object entity, not an intrinsic
 125   call s2(sin)
 126   !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure
 127   call s3(cos)
 128 contains
 129   subroutine s2(x)
 130     real :: x
 131   end
 132   subroutine s3(p)
 133     procedure(real) :: p
 134   end
 135 end
 136
 137 subroutine p04
 138   implicit none
 139   !ERROR: No explicit type declared for 'index'
 140   call s1(index)
 141 end
 142
 143 subroutine p05
 144   integer :: a1(2), a2, a3
 145   !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
 146   !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
 147   call s1(a1, a2, a3)
 148 contains
 149   elemental subroutine s1(a, b, c)
 150     integer, intent(in) :: a
 151     integer, intent(out) :: b
 152     integer, intent(inout) :: c
 153     b = a
 154     c = a
 155   end
 156 end