re PR fortran/55618 (Failures with ISO_Varying_String test suite)

2013-01-08  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/55618
	* trans-expr.c (gfc_conv_procedure_call): Dereference scalar
	character function arguments to elemental procedures in
	scalarization loops.

2013-01-08  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/55618
	* gfortran.dg/elemental_scalar_args_2.f90: New test.

From-SVN: r195004

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4dd433d..6d1b2c6 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2013-01-08  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/55618
+       * trans-expr.c (gfc_conv_procedure_call): Dereference scalar
+       character function arguments to elemental procedures in
+       scalarization loops.
+
 2013-01-07  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/55763

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9452e27..7b41c65 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4115,7 +4115,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
            }
          else
-           gfc_conv_expr_reference (&parmse, e);
+           {
+             gfc_conv_expr_reference (&parmse, e);
+             if (e->ts.type == BT_CHARACTER && !e->rank
+                 && e->expr_type == EXPR_FUNCTION)
+               parmse.expr = build_fold_indirect_ref_loc (input_location,
+                                                          parmse.expr);
+           }
 
          if (fsym && fsym->ts.type == BT_DERIVED
              && gfc_is_class_container_ref (e))

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d7a0805..c713b2a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-01-08  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/55618
+       * gfortran.dg/elemental_scalar_args_2.f90: New test.
+
 2013-01-07  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/55763

diff --git a/gcc/testsuite/gfortran.dg/elemental_scalar_args_2.f90 b/gcc/testsuite/gfortran.dg/elemental_scalar_args_2.f90
new file mode 100644 (file)
index 0000000..c2b5df8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_scalar_args_2.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! Test the fix for PR55618, in which character scalar function arguments to
+! elemental functions would gain an extra indirect reference thus causing
+! failures in Vst17.f95, Vst 30.f95 and Vst31.f95 in the iso_varying_string
+! testsuite, where elemental tests are done.
+!
+! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+  integer, dimension (2) :: i = [1,2]
+  integer :: j = 64
+  character (len = 2) :: chr1 = "lm"
+  character (len = 1), dimension (2) :: chr2 = ["r", "s"]
+  if (any (foo (i, bar()) .ne. ["a", "b"])) call abort    ! This would fail
+  if (any (foo (i, "xy") .ne. ["x", "y"])) call abort     ! OK - not a function
+  if (any (foo (i, chr1) .ne. ["l", "m"])) call abort     ! ditto
+  if (any (foo (i, char (j)) .ne. ["A", "B"])) call abort ! This would fail
+  if (any (foo (i, chr2) .ne. ["s", "u"])) call abort     ! OK - not a scalar
+  if (any (foo (i, bar2()) .ne. ["e", "g"])) call abort   ! OK - not a scalar function
+contains
+  elemental character(len = 1) function foo (arg1, arg2)
+    integer, intent (in) :: arg1
+    character(len = *), intent (in) :: arg2
+    if (len (arg2) > 1) then
+      foo = arg2(arg1:arg1)
+    else
+      foo = char (ichar (arg2) + arg1)
+    end if
+  end function
+  character(len = 2) function bar ()
+    bar = "ab"
+  end function
+  function bar2 () result(res)
+    character (len = 1), dimension(2) :: res
+    res = ["d", "e"]
+  end function
+end