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

5 files changed, 46 insertions, 23 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 05e7b9f..80111f3 100644
--- 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 2a80841..70098b4 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 e9b9480..047ced9 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 ca73666..b004d09 100644
--- 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
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