2007-08-17 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. * gfortran.dg/assumed_charlen_sharing.f90: New test. --- gcc/fortran/decl.c.jj 2007-02-20 22:38:20.000000000 +0100 +++ gcc/fortran/decl.c 2007-08-21 20:50:33.000000000 +0200 @@ -1086,10 +1086,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; --- gcc/fortran/trans-decl.c.jj 2007-03-12 08:28:13.000000000 +0100 +++ gcc/fortran/trans-decl.c 2007-08-21 20:50:33.000000000 +0200 @@ -1417,25 +1417,8 @@ create_function_arglist (gfc_symbol * sy 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); --- gcc/testsuite/gfortran.dg/assumed_charlen_sharing.f90.jj 2007-08-21 08:29:57.000000000 +0200 +++ gcc/testsuite/gfortran.dg/assumed_charlen_sharing.f90 2007-08-21 08:29:57.000000000 +0200 @@ -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