90 lines
2.8 KiB
Diff
90 lines
2.8 KiB
Diff
|
2007-08-17 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.
|
||
|
|
|
||
|
|
* 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
|