gcc/testsuite/gfortran.dg/elemental_scalar_args_2.f90

   1 ! { dg-do run }
   2 ! Test the fix for PR55618, in which character scalar function arguments to
   3 ! elemental functions would gain an extra indirect reference thus causing
   4 ! failures in Vst17.f95, Vst 30.f95 and Vst31.f95 in the iso_varying_string
   5 ! testsuite, where elemental tests are done.
   6 !
   7 ! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
   8 !
   9   integer, dimension (2) :: i = [1,2]
  10   integer :: j = 64
  11   character (len = 2) :: chr1 = "lm"
  12   character (len = 1), dimension (2) :: chr2 = ["r", "s"]
  13   if (any (foo (i, bar()) .ne. ["a", "b"])) call abort    ! This would fail
  14   if (any (foo (i, "xy") .ne. ["x", "y"])) call abort     ! OK - not a function
  15   if (any (foo (i, chr1) .ne. ["l", "m"])) call abort     ! ditto
  16   if (any (foo (i, char (j)) .ne. ["A", "B"])) call abort ! This would fail
  17   if (any (foo (i, chr2) .ne. ["s", "u"])) call abort     ! OK - not a scalar
  18   if (any (foo (i, bar2()) .ne. ["e", "g"])) call abort   ! OK - not a scalar function
  19 contains
  20   elemental character(len = 1) function foo (arg1, arg2)
  21     integer, intent (in) :: arg1
  22     character(len = *), intent (in) :: arg2
  23     if (len (arg2) > 1) then
  24       foo = arg2(arg1:arg1)
  25     else
  26       foo = char (ichar (arg2) + arg1)
  27     end if
  28   end function
  29   character(len = 2) function bar ()
  30     bar = "ab"
  31   end function
  32   function bar2 () result(res)
  33     character (len = 1), dimension(2) :: res
  34     res = ["d", "e"]
  35   end function
  36 end