re PR fortran/49638 ([OOP] length parameter is ignored when overriding type bound character functions with constant length.)

2011-08-07  Janus Weil  <janus@gcc.gnu.org>
	    Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/49638
	* dependency.c (are_identical_variables): For dummy arguments only
	check for equal names, not equal symbols.
	* interface.c (gfc_check_typebound_override): Add checking for rank
	and character length.

2011-08-07  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/49638
	* gfortran.dg/typebound_override_1.f90: New.

Co-Authored-By: Thomas Koenig <tkoenig@gcc.gnu.org>

From-SVN: r177550

3 files changed, 53 insertions, 6 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0c38317..a86afc6 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,13 @@
 2011-08-07  Janus Weil  <janus@gcc.gnu.org>
+	    Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/49638
+	* dependency.c (are_identical_variables): For dummy arguments only
+	check for equal names, not equal symbols.
+	* interface.c (gfc_check_typebound_override): Add checking for rank
+	and character length.
+
+2011-08-07  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/49638
 	* dependency.h (gfc_is_same_range,gfc_are_identical_variables): Remove
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index b49cf54..5238c86 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -123,8 +123,18 @@ are_identical_variables (gfc_expr *e1, gfc_expr *e2)
 {
   gfc_ref *r1, *r2;
 
-  if (e1->symtree->n.sym != e2->symtree->n.sym)
-    return false;
+  if (e1->symtree->n.sym->attr.dummy && e2->symtree->n.sym->attr.dummy)
+    {
+      /* Dummy arguments: Only check for equal names.  */
+      if (e1->symtree->n.sym->name != e2->symtree->n.sym->name)
+	return false;
+    }
+  else
+    {
+      /* Check for equal symbols.  */
+      if (e1->symtree->n.sym != e2->symtree->n.sym)
+	return false;
+    }
 
   /* Volatile variables should never compare equal to themselves.  */
 
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 8998072..0ea244d 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3556,15 +3556,43 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
 	}
 
       /* FIXME:  Do more comprehensive checking (including, for instance, the
-	 rank and array-shape).  */
+	 array-shape).  */
       gcc_assert (proc_target->result && old_target->result);
-      if (!gfc_compare_types (&proc_target->result->ts,
-			      &old_target->result->ts))
+      if (!compare_type_rank (proc_target->result, old_target->result))
 	{
 	  gfc_error ("'%s' at %L and the overridden FUNCTION should have"
-		     " matching result types", proc->name, &where);
+		     " matching result types and ranks", proc->name, &where);
 	  return FAILURE;
 	}
+	
+      /* Check string length.  */
+      if (proc_target->result->ts.type == BT_CHARACTER
+	  && proc_target->result->ts.u.cl && old_target->result->ts.u.cl)
+	{
+	  int compval = gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
+					      old_target->result->ts.u.cl->length);
+	  switch (compval)
+	  {
+	    case -1:
+	    case 1:
+	      gfc_error ("Character length mismatch between '%s' at '%L' and "
+			 "overridden FUNCTION", proc->name, &where);
+	      return FAILURE;
+
+	    case -2:
+	      gfc_warning ("Possible character length mismatch between '%s' at"
+			   " '%L' and overridden FUNCTION", proc->name, &where);
+	      break;
+
+	    case 0:
+	      break;
+
+	    default:
+	      gfc_internal_error ("gfc_check_typebound_override: Unexpected "
+				  "result %i of gfc_dep_compare_expr", compval);
+	      break;
+	  }
+	}
     }
 
   /* If the overridden binding is PUBLIC, the overriding one must not be