diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2013-01-08 06:13:52 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2013-01-08 06:13:52 +0000 |
| commit | ec947dd39aa440205aa417f7809931b5cd6cda6b (patch) | |
| tree | 75220b6492e48442cc1bf53c89e338cc7cddac9d | |
| parent | 2aa617a76a35ea61377a37af7a4573e2242d511d (diff) | |
| download | gcc-ec947dd39aa440205aa417f7809931b5cd6cda6b.zip gcc-ec947dd39aa440205aa417f7809931b5cd6cda6b.tar.gz gcc-ec947dd39aa440205aa417f7809931b5cd6cda6b.tar.bz2 | |
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
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 8 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/elemental_scalar_args_2.f90 | 36 |
4 files changed, 55 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4dd433d..6d1b2c68 100644 --- 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 --- 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 --- 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 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 |