From 9b21a3805360cf92d94c3767743f85f992f8293d Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Fri, 24 Aug 2007 01:25:42 +0200 Subject: [PATCH] decl.c (variable_decl): Don't share charlen structs if length == NULL. * decl.c (variable_decl): Don't share charlen structs if length == NULL. * trans-decl.c (create_function_arglist): Assert f->sym->ts.cl->backend_decl is NULL instead of unsharing charlen struct here. * gfortran.dg/assumed_charlen_sharing.f90: New test. From-SVN: r127748 --- gcc/fortran/ChangeLog | 8 +++++ gcc/fortran/decl.c | 7 +++-- gcc/fortran/trans-decl.c | 21 ++------------ gcc/testsuite/ChangeLog | 4 ++- .../gfortran.dg/assumed_charlen_sharing.f90 | 29 +++++++++++++++++++ 5 files changed, 46 insertions(+), 23 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/assumed_charlen_sharing.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 05e7b9f897b..80111f31551 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2007-08-23 Jakub Jelinek + + * decl.c (variable_decl): Don't share charlen structs if + length == NULL. + * trans-decl.c (create_function_arglist): Assert + f->sym->ts.cl->backend_decl is NULL instead of unsharing + charlen struct here. + 2007-08-23 Francois-Xavier Coudert PR fortran/33095 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 2a80841d5df..70098b4f053 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1462,10 +1462,11 @@ variable_decl (int elem) break; /* Non-constant lengths need to be copied after the first - element. */ + element. Also copy assumed lengths. */ case MATCH_NO: - if (elem > 1 && current_ts.cl->length - && current_ts.cl->length->expr_type != EXPR_CONSTANT) + if (elem > 1 + && (current_ts.cl->length == NULL + || current_ts.cl->length->expr_type != EXPR_CONSTANT)) { cl = gfc_get_charlen (); cl->next = gfc_current_ns->cl_list; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index e9b94802190..047ced92c1b 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1458,25 +1458,8 @@ create_function_arglist (gfc_symbol * sym) if (!f->sym->ts.cl->length) { TREE_USED (length) = 1; - if (!f->sym->ts.cl->backend_decl) - f->sym->ts.cl->backend_decl = length; - else - { - /* there is already another variable using this - gfc_charlen node, build a new one for this variable - and chain it into the list of gfc_charlens. - This happens for e.g. in the case - CHARACTER(*)::c1,c2 - since CHARACTER declarations on the same line share - the same gfc_charlen node. */ - gfc_charlen *cl; - - cl = gfc_get_charlen (); - cl->backend_decl = length; - cl->next = f->sym->ts.cl->next; - f->sym->ts.cl->next = cl; - f->sym->ts.cl = cl; - } + gcc_assert (!f->sym->ts.cl->backend_decl); + f->sym->ts.cl->backend_decl = length; } hidden_typelist = TREE_CHAIN (hidden_typelist); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ca73666374a..b004d097d9c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,4 +1,6 @@ -2007-08-23 Jakub Jelinek +2007-08-24 Jakub Jelinek + + * gfortran.dg/assumed_charlen_sharing.f90: New test. PR c++/31941 * g++.dg/parse/crash37.C: New test. diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_sharing.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_sharing.f90 new file mode 100644 index 00000000000..0c1c38a87e2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/assumed_charlen_sharing.f90 @@ -0,0 +1,29 @@ +! This testcase was miscompiled, because ts.cl +! in function bar was initially shared between both +! dummy arguments. Although it was later unshared, +! all expressions which copied ts.cl from bar2 +! before that used incorrectly bar1's length +! instead of bar2. +! { dg-do run } + +subroutine foo (foo1, foo2) + implicit none + integer, intent(in) :: foo2 + character(*), intent(in) :: foo1(foo2) +end subroutine foo + +subroutine bar (bar1, bar2) + implicit none + character(*), intent(in) :: bar1, bar2 + + call foo ((/ bar2 /), 1) +end subroutine bar + +program test + character(80) :: str1 + character(5) :: str2 + + str1 = 'String' + str2 = 'Strng' + call bar (str2, str1) +end program test -- 2.30.2