gcc/testsuite/gfortran.dg/elemental_subroutine_1.f90

   1 ! { dg-do run }
   2 ! Test the fix for pr22146, where and elemental subroutine with
   3 ! array actual arguments would cause an ICE in gfc_conv_function_call.
   4 ! The module is the original test case and the rest is a basic
   5 ! functional test of the scalarization of the function call.
   6 !
   7 ! Contributed by Erik Edelmann  <erik.edelmann@iki.fi>
   8 !             and Paul Thomas   <pault@gcc.gnu.org>
   9
  10   module pr22146
  11
  12 contains
  13
  14     elemental subroutine foo(a)
  15       integer, intent(out) :: a
  16       a = 0
  17     end subroutine foo
  18
  19     subroutine bar()
  20       integer :: a(10)
  21       call foo(a)
  22     end subroutine bar
  23
  24 end module pr22146
  25
  26   use pr22146
  27   real, dimension (2)  :: x, y
  28   real :: u, v
  29   x = (/1.0, 2.0/)
  30   u = 42.0
  31
  32   call bar ()
  33
  34 ! Check the various combinations of scalar and array.
  35   call foobar (x, y)
  36   if (any(y.ne.-x)) call abort ()
  37
  38   call foobar (u, y)
  39   if (any(y.ne.-42.0)) call abort ()
  40
  41   call foobar (u, v)
  42   if (v.ne.-42.0) call abort ()
  43
  44   v = 2.0
  45   call foobar (v, x)
  46   if (any(x /= -2.0)) call abort ()
  47
  48 ! Test an expression in the INTENT(IN) argument
  49   x = (/1.0, 2.0/)
  50   call foobar (cos (x) + u, y)
  51   if (any(abs (y + cos (x) + u) .gt. 4.0e-6)) call abort ()
  52
  53 contains
  54
  55   elemental subroutine foobar (a, b)
  56     real, intent(IN) :: a
  57     real, intent(out) :: b
  58     b = -a
  59   end subroutine foobar
  60 end