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   call foobar (x, v)
  45   if (v.ne.-2.0) call abort ()
  46
  47 ! Test an expression in the INTENT(IN) argument
  48   call foobar (cos (x) + u, y)
  49   if (any(abs (y + cos (x) + u) .gt. 2.0e-6)) call abort ()
  50
  51 contains
  52
  53   elemental subroutine foobar (a, b)
  54     real, intent(IN) :: a
  55     real, intent(out) :: b
  56     b = -a
  57   end subroutine foobar
  58 end