+2007-08-23 Jakub Jelinek <jakub@redhat.com>
+
+ * 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 <fxcoudert@gcc.gnu.org>
PR fortran/33095
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;
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);
-2007-08-23 Jakub Jelinek <jakub@redhat.com>
+2007-08-24 Jakub Jelinek <jakub@redhat.com>
+
+ * gfortran.dg/assumed_charlen_sharing.f90: New test.
PR c++/31941
* g++.dg/parse/crash37.C: New test.
--- /dev/null
+! 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