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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 05e7b9f897b85110476557f803fbb901409e3f3e..80111f3155139f01a555d802acdf100a362bac1f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+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

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 2a80841d5dff3fe0771f6dd1e2a58deac957dfd5..70098b4f0534ffcc9c500df32c19848cbdfe5e25 100644 (file)
--- 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 e9b9480219049e435d9e1d2196b2b9a744f0e582..047ced92c1ba9257fae283f74eed7eb817416905 100644 (file)
--- 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 ca73666374a4991e03b8f379dcbdbf2ee41a13b8..b004d097d9cdabdf1a10a6a184d1af49cb2af5c6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,4 +1,6 @@
-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.

diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_sharing.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_sharing.f90
new file mode 100644 (file)
index 0000000..0c1c38a
--- /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