flang/test/Semantics/call40.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! %VAL en %REF legacy extension semantic tests.
   3
   4 subroutine val_errors(array, string, polymorphic, derived)
   5   type t
   6     integer :: t
   7   end type
   8   integer :: array(10)
   9   character(*) :: string
  10   type(t) :: derived
  11   type(*) :: polymorphic
  12   interface
  13     subroutine foo5(a)
  14       integer a(:)
  15     end
  16   end interface
  17   !ERROR: %VAL argument must be a scalar numeric or logical expression
  18   call foo1(%val(array))
  19   !ERROR: %VAL argument must be a scalar numeric or logical expression
  20   call foo2(%val(string))
  21   !ERROR: %VAL argument must be a scalar numeric or logical expression
  22   call foo3(%val(derived))
  23   !ERROR: Assumed type actual argument requires an explicit interface
  24   !ERROR: %VAL argument must be a scalar numeric or logical expression
  25   call foo4(%val(polymorphic))
  26   !ERROR: %VAL or %REF are not allowed for dummy argument 'a=' that must be passed by means of a descriptor
  27   call foo5(%ref(array))
  28 end subroutine
  29
  30 subroutine val_ok()
  31   integer :: array(10)
  32   real :: x
  33   logical :: l
  34   complex :: c
  35   call ok1(%val(array(1)))
  36   call ok2(%val(x))
  37   call ok3(%val(l))
  38   call ok4(%val(c))
  39   call ok5(%val(42))
  40   call ok6(%val(x+x))
  41 end subroutine
  42
  43 subroutine ref_ok(array, string, derived)
  44   type t
  45     integer :: t
  46   end type
  47   integer :: array(10)
  48   character(*) :: string
  49   type(t) :: derived
  50   call rok1(%ref(array))
  51   call rok2(%ref(string))
  52   call rok3(%ref(derived))
  53 end subroutine