From b68a9f34f170f48a08c737d1cbfdc147dc42f275 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Wed, 16 Aug 2017 17:21:22 +0000 Subject: [PATCH] re PR fortran/81116 (Last character of allocatable-length string reset to blank in an assigment) 2017-08-16 Thomas Koenig PR fortran/81116 * frontend-passes.c (realloc_string_callback): If expression is a concatenation, also check for dependency. (constant_string_length): Check for presence of symtree. 2017-08-16 Thomas Koenig PR fortran/81116 * gfortran.dg/realloc_on_assignment_29.f90: New test. From-SVN: r251125 --- gcc/fortran/ChangeLog | 7 ++++++ gcc/fortran/frontend-passes.c | 25 +++++++++++-------- gcc/testsuite/ChangeLog | 5 ++++ .../gfortran.dg/realloc_on_assign_29.f90 | 13 ++++++++++ 4 files changed, 40 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/realloc_on_assign_29.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 24e5a244db8..4a572cfb4ae 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2017-08-16 Thomas Koenig + + PR fortran/81116 + * frontend-passes.c (realloc_string_callback): If expression is a + concatenation, also check for dependency. + (constant_string_length): Check for presence of symtree. + 2017-08-13 Thomas Koenig * gfortran.texi: Document format of unformatted sequential files. diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 11c75035210..7a3d0272d47 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -238,21 +238,25 @@ realloc_string_callback (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, return 0; expr2 = gfc_discard_nops (co->expr2); - if (expr2->expr_type != EXPR_VARIABLE) - return 0; - found_substr = false; - for (ref = expr2->ref; ref; ref = ref->next) + if (expr2->expr_type == EXPR_VARIABLE) { - if (ref->type == REF_SUBSTRING) + found_substr = false; + for (ref = expr2->ref; ref; ref = ref->next) { - found_substr = true; - break; + if (ref->type == REF_SUBSTRING) + { + found_substr = true; + break; + } } + if (!found_substr) + return 0; } - if (!found_substr) + else if (expr2->expr_type != EXPR_OP + || expr2->value.op.op != INTRINSIC_CONCAT) return 0; - + if (!gfc_check_dependency (expr1, expr2, true)) return 0; @@ -625,7 +629,8 @@ constant_string_length (gfc_expr *e) /* Return length of char symbol, if constant. */ - if (e->symtree->n.sym->ts.u.cl && e->symtree->n.sym->ts.u.cl->length + if (e->symtree && e->symtree->n.sym->ts.u.cl + && e->symtree->n.sym->ts.u.cl->length && e->symtree->n.sym->ts.u.cl->length->expr_type == EXPR_CONSTANT) return gfc_copy_expr (e->symtree->n.sym->ts.u.cl->length); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2b4c63ab712..260cc38a0fd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-08-16 Thomas Koenig + + PR fortran/81116 + * gfortran.dg/realloc_on_assignment_29.f90: New test. + 2017-08-16 Uros Bizjak PR target/46091 diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_29.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_29.f90 new file mode 100644 index 00000000000..e7a7d2899d2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_29.f90 @@ -0,0 +1,13 @@ +! { dg-do run } +! PR fortran/81116 +! The assignment was broken due to a missing temporary. +! Original test case by Clive Page. + +program test10 + implicit none + character(:), allocatable :: string + ! + string = '1234567890' + string = string(1:5) // string(7:) + if (string /= '123457890') call abort +end program test10 -- 2.30.2