From ec947dd39aa440205aa417f7809931b5cd6cda6b Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Tue, 8 Jan 2013 06:13:52 +0000 Subject: [PATCH] re PR fortran/55618 (Failures with ISO_Varying_String test suite) 2013-01-08 Paul Thomas 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 PR fortran/55618 * gfortran.dg/elemental_scalar_args_2.f90: New test. From-SVN: r195004 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/trans-expr.c | 8 ++++- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/elemental_scalar_args_2.f90 | 36 +++++++++++++++++++ 4 files changed, 55 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/elemental_scalar_args_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4dd433d4d263..6d1b2c68b104 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2013-01-08 Paul Thomas + + 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 PR fortran/55763 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 9452e2769627..7b41c65a374f 100644 --- 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 d7a0805609ea..c713b2a098c9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-01-08 Paul Thomas + + PR fortran/55618 + * gfortran.dg/elemental_scalar_args_2.f90: New test. + 2013-01-07 Tobias Burnus 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 index 000000000000..c2b5df8d18b0 --- /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 +! + 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