[Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.

public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed

* [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
@ 2011-08-04 21:42 Janus Weil
  2011-08-05 17:26 ` Mikael Morin
  2011-08-05 21:23 ` Thomas Koenig
  0 siblings, 2 replies; 43+ messages in thread
From: Janus Weil @ 2011-08-04 21:42 UTC (permalink / raw)
  To: gfortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 1561 bytes --]

Hi all,

attached is a draft patch fixing the PR in the subject line and
extending the checks for overriding type-bound functions. It regtests
cleanly on x86_64-unknown-linux-gnu already, but I would like to have
some feedback.

The patch is rather large, but most of it is just mechanical, due to
the fact that I added an extra argument to 'gfc_dep_compare_expr'. I
use this function to compare the string-length expressions of a
character-valued TBP and an overriding procedure (the standard
requires them to be equal). Inside 'gfc_dep_compare_expr' I had to add
a minor piece to correctly respect commutativity of the multiplication
operator (for the addition operator this was done already). The extra
argument controls whether we check variable symbols for equality or
just their names. For the overriding checks it is sufficient to check
for names, because the arguments of the overriding procedure are
required to have the same names as in the base procedure.

Moreover I extended the type check in 'check_typebound_override' to
also check for correct rank, via 'compare_type_rank' instead of
'gfc_compare_types'. However, the former was local to interface.c, so
I made it public (and should probably also rename it to gfc_...), or
should one rather move 'check_typebound_override' to interface.c
itself? I think it fits in there pretty nicely. After all it is
checking the interfaces of overriding procedures.

Anything else missing for this patch? Or is it ok for trunk? (I will
add corresponding test cases and a ChangeLog, of course.)

Cheers,
Janus

[-- Attachment #2: pr49638.diff --]
[-- Type: text/x-diff, Size: 23327 bytes --]

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 177386)
+++ gcc/fortran/interface.c	(working copy)
@@ -501,7 +501,7 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec
    and types.  Returns nonzero if they have the same rank and type,
    zero otherwise.  */
 
-static int
+int
 compare_type_rank (gfc_symbol *s1, gfc_symbol *s2)
 {
   int r1, r2;
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 177386)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -498,7 +498,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, in
 
   /* If the start and end expressions are equal, the length is one.  */
   if (ref->u.ss.end
-      && gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end) == 0)
+      && gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end, false) == 0)
     tmp = build_int_cst (gfc_charlen_type_node, 1);
   else
     {
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 177386)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2822,6 +2822,7 @@ gfc_try gfc_ref_dimen_size (gfc_array_ref *, int d
 void gfc_free_interface (gfc_interface *);
 int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
 int gfc_compare_types (gfc_typespec *, gfc_typespec *);
+int compare_type_rank (gfc_symbol *, gfc_symbol *);
 int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int,
 			    char *, int);
 void gfc_check_interfaces (gfc_namespace *);
@@ -2892,7 +2893,7 @@ gfc_namespace* gfc_build_block_ns (gfc_namespace *
 
 /* dependency.c */
 int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool);
-int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
+int gfc_dep_compare_expr (gfc_expr *, gfc_expr *, bool);
 
 /* check.c */
 gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(revision 177386)
+++ gcc/fortran/trans-stmt.c	(working copy)
@@ -2552,7 +2552,7 @@ check_forall_dependencies (gfc_code *c, stmtblock_
 	  break;
 
       if (rref && lref
-	    && gfc_dep_compare_expr (rref->u.ss.start, lref->u.ss.start) < 0)
+	  && gfc_dep_compare_expr (rref->u.ss.start, lref->u.ss.start, false) < 0)
 	{
 	  forall_make_variable_temp (c, pre, post);
 	  need_temp = 0;
Index: gcc/fortran/frontend-passes.c
===================================================================
--- gcc/fortran/frontend-passes.c	(revision 177386)
+++ gcc/fortran/frontend-passes.c	(working copy)
@@ -681,7 +681,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
       || (op1->ts.type != BT_REAL && op2->ts.type != BT_REAL
 	  && op1->ts.type != BT_COMPLEX && op2->ts.type != BT_COMPLEX))
     {
-      eq = gfc_dep_compare_expr (op1, op2);
+      eq = gfc_dep_compare_expr (op1, op2, false);
       if (eq == -2)
 	{
 	  /* Replace A // B < A // C with B < C, and A // B < C // B
@@ -695,7 +695,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
 	      gfc_expr *op1_right = op1->value.op.op2;
 	      gfc_expr *op2_right = op2->value.op.op2;
 
-	      if (gfc_dep_compare_expr (op1_left, op2_left) == 0)
+	      if (gfc_dep_compare_expr (op1_left, op2_left, false) == 0)
 		{
 		  /* Watch out for 'A ' // x vs. 'A' // x.  */
 
@@ -722,7 +722,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
 		      return true;
 		    }
 		}
-	      if (gfc_dep_compare_expr (op1_right, op2_right) == 0)
+	      if (gfc_dep_compare_expr (op1_right, op2_right, false) == 0)
 		{
 		  free (op1_right);
 		  free (op2_right);
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 177386)
+++ gcc/fortran/resolve.c	(working copy)
@@ -2585,7 +2585,8 @@ is_scalar_expr_ptr (gfc_expr *expr)
         {
         case REF_SUBSTRING:
           if (ref->u.ss.start == NULL || ref->u.ss.end == NULL
-	      || gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end) != 0)
+	      || gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end,
+				       false) != 0)
 	    retval = FAILURE;
           break;
 
@@ -7139,7 +7140,7 @@ resolve_allocate_deallocate (gfc_code *code, const
 			  gfc_array_ref *par = &(pr->u.ar);
 			  gfc_array_ref *qar = &(qr->u.ar);
 			  if (gfc_dep_compare_expr (par->start[0],
-						    qar->start[0]) != 0)
+						    qar->start[0], false) != 0)
 			      break;
 			}
 		    }
@@ -10672,8 +10673,8 @@ error:
 }
 
 
-/* Check that it is ok for the typebound procedure proc to override the
-   procedure old.  */
+/* Check that it is ok for the typebound procedure 'proc' to override the
+   procedure 'old' (F08:4.5.7.3).  */
 
 static gfc_try
 check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
@@ -10759,16 +10760,27 @@ check_typebound_override (gfc_symtree* proc, gfc_s
 	  return FAILURE;
 	}
 
-      /* FIXME:  Do more comprehensive checking (including, for instance, the
-	 rank and array-shape).  */
+      /* FIXME:  Do more comprehensive checking (including, for instance,
+	 the 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
+	  && gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
+				   old_target->result->ts.u.cl->length,
+				   true) != 0)
+	{
+	  gfc_error ("Character length mismatch between '%s' at '%L' "
+		     "and overridden FUNCTION", proc->name, &where);
+	  return FAILURE;
+	}
     }
 
   /* If the overridden binding is PUBLIC, the overriding one must not be
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(revision 177386)
+++ gcc/fortran/check.c	(working copy)
@@ -667,7 +667,7 @@ gfc_var_strlen (const gfc_expr *a)
 	  end_a = mpz_get_si (ra->u.ss.end->value.integer);
 	  return end_a - start_a + 1;
 	}
-      else if (gfc_dep_compare_expr (ra->u.ss.start, ra->u.ss.end) == 0)
+      else if (gfc_dep_compare_expr (ra->u.ss.start, ra->u.ss.end, false) == 0)
 	return 1;
       else
 	return -1;
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c	(revision 177386)
+++ gcc/fortran/dependency.c	(working copy)
@@ -105,7 +105,7 @@ identical_array_ref (gfc_array_ref *a1, gfc_array_
       gcc_assert (a1->dimen == a2->dimen);
       for (i = 0; i < a1->dimen; i++)
 	{
-	  if (gfc_dep_compare_expr (a1->start[i], a2->start[i]) != 0)
+	  if (gfc_dep_compare_expr (a1->start[i], a2->start[i], false) != 0)
 	    return false;
 	}
       return true;
@@ -163,8 +163,8 @@ gfc_are_identical_variables (gfc_expr *e1, gfc_exp
 	  break;
 
 	case REF_SUBSTRING:
-	  if (gfc_dep_compare_expr (r1->u.ss.start, r2->u.ss.start) != 0
-	      || gfc_dep_compare_expr (r1->u.ss.end, r2->u.ss.end) != 0)
+	  if (gfc_dep_compare_expr (r1->u.ss.start, r2->u.ss.start, false) != 0
+	      || gfc_dep_compare_expr (r1->u.ss.end, r2->u.ss.end, false) != 0)
 	    return false;
 	  break;
 
@@ -208,7 +208,7 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr
 	    return -2;
 	  
 	  if (args1->expr != NULL && args2->expr != NULL
-	      && gfc_dep_compare_expr (args1->expr, args2->expr) != 0)
+	      && gfc_dep_compare_expr (args1->expr, args2->expr, false) != 0)
 	    return -2;
 	  
 	  args1 = args1->next;
@@ -221,10 +221,12 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr
 }
 
 /* Compare two values.  Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2,
-   and -2 if the relationship could not be determined.  */
+   and -2 if the relationship could not be determined.  If 'var_name_only' is
+   true, we only check the variable names for equality, not the symbols
+   themselves.  */
 
 int
-gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
+gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2, bool var_name_only)
 {
   gfc_actual_arglist *args1;
   gfc_actual_arglist *args2;
@@ -258,31 +260,31 @@ int
   if (n1 != NULL)
     {
       if (n2 != NULL)
-	return gfc_dep_compare_expr (n1, n2);
+	return gfc_dep_compare_expr (n1, n2, var_name_only);
       else
-	return gfc_dep_compare_expr (n1, e2);
+	return gfc_dep_compare_expr (n1, e2, var_name_only);
     }
   else
     {
       if (n2 != NULL)
-	return gfc_dep_compare_expr (e1, n2);
+	return gfc_dep_compare_expr (e1, n2, var_name_only);
     }
   
   if (e1->expr_type == EXPR_OP
       && (e1->value.op.op == INTRINSIC_UPLUS
 	  || e1->value.op.op == INTRINSIC_PARENTHESES))
-    return gfc_dep_compare_expr (e1->value.op.op1, e2);
+    return gfc_dep_compare_expr (e1->value.op.op1, e2, var_name_only);
   if (e2->expr_type == EXPR_OP
       && (e2->value.op.op == INTRINSIC_UPLUS
 	  || e2->value.op.op == INTRINSIC_PARENTHESES))
-    return gfc_dep_compare_expr (e1, e2->value.op.op1);
+    return gfc_dep_compare_expr (e1, e2->value.op.op1, var_name_only);
 
   if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
     {
       /* Compare X+C vs. X.  */
       if (e1->value.op.op2->expr_type == EXPR_CONSTANT
 	  && e1->value.op.op2->ts.type == BT_INTEGER
-	  && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
+	  && gfc_dep_compare_expr (e1->value.op.op1, e2, var_name_only) == 0)
 	return mpz_sgn (e1->value.op.op2->value.integer);
 
       /* Compare P+Q vs. R+S.  */
@@ -290,8 +292,8 @@ int
 	{
 	  int l, r;
 
-	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
-	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only);
+	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2, var_name_only);
 	  if (l == 0 && r == 0)
 	    return 0;
 	  if (l == 0 && r != -2)
@@ -303,8 +305,8 @@ int
 	  if (l == -1 && r == -1)
 	    return -1;
 
-	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2);
-	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1);
+	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2, var_name_only);
+	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1, var_name_only);
 	  if (l == 0 && r == 0)
 	    return 0;
 	  if (l == 0 && r != -2)
@@ -323,7 +325,7 @@ int
     {
       if (e2->value.op.op2->expr_type == EXPR_CONSTANT
 	  && e2->value.op.op2->ts.type == BT_INTEGER
-	  && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
+	  && gfc_dep_compare_expr (e1, e2->value.op.op1, var_name_only) == 0)
 	return -mpz_sgn (e2->value.op.op2->value.integer);
     }
 
@@ -332,7 +334,7 @@ int
     {
       if (e1->value.op.op2->expr_type == EXPR_CONSTANT
 	  && e1->value.op.op2->ts.type == BT_INTEGER
-	  && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
+	  && gfc_dep_compare_expr (e1->value.op.op1, e2, var_name_only) == 0)
 	return -mpz_sgn (e1->value.op.op2->value.integer);
 
       /* Compare P-Q vs. R-S.  */
@@ -340,8 +342,8 @@ int
 	{
 	  int l, r;
 
-	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
-	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only);
+	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2, var_name_only);
 	  if (l == 0 && r == 0)
 	    return 0;
 	  if (l != -2 && r == 0)
@@ -362,8 +364,8 @@ int
     {
       int l, r;
 
-      l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
-      r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+      l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only);
+      r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2, var_name_only);
 
       if (l == -2)
 	return -2;
@@ -396,7 +398,7 @@ int
     {
       if (e2->value.op.op2->expr_type == EXPR_CONSTANT
 	  && e2->value.op.op2->ts.type == BT_INTEGER
-	  && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
+	  && gfc_dep_compare_expr (e1, e2->value.op.op1, var_name_only) == 0)
 	return mpz_sgn (e2->value.op.op2->value.integer);
     }
 
@@ -421,8 +423,10 @@ int
       return 1;
 
     case EXPR_VARIABLE:
-      if (gfc_are_identical_variables (e1, e2))
+      if (var_name_only && e1->symtree->n.sym->name == e2->symtree->n.sym->name)
 	return 0;
+      else if (gfc_are_identical_variables (e1, e2))
+	return 0;
       else
 	return -2;
 
@@ -432,13 +436,18 @@ int
 	return -2;
       if (e1->value.op.op2 == 0)
 	{
-	  i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+	  i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only);
 	  return i == 0 ? 0 : -2;
 	}
-      if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0
-	  && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0)
+      if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only) == 0
+	  && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2, var_name_only) == 0)
 	return 0;
-      /* TODO Handle commutative binary operators here?  */
+      else if (e1->value.op.op == INTRINSIC_TIMES
+	       && gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2, var_name_only) == 0
+	       && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1, var_name_only) == 0)
+	/* Commutativity of multiplication.  */
+	return 0;
+
       return -2;
 
     case EXPR_FUNCTION:
@@ -487,7 +496,7 @@ gfc_is_same_range (gfc_array_ref *ar1, gfc_array_r
     }
   else if (e1 && e2)
     {
-      i = gfc_dep_compare_expr (e1, e2);
+      i = gfc_dep_compare_expr (e1, e2, false);
       if (i == -2)
 	return def;
       else if (i != 0)
@@ -511,7 +520,7 @@ gfc_is_same_range (gfc_array_ref *ar1, gfc_array_r
       if (!(e1 && e2))
 	return def;
 
-      i = gfc_dep_compare_expr (e1, e2);
+      i = gfc_dep_compare_expr (e1, e2, false);
       if (i == -2)
 	return def;
       else if (i != 0)
@@ -534,7 +543,7 @@ gfc_is_same_range (gfc_array_ref *ar1, gfc_array_r
       if (!(e1 && e2))
 	return def;
 
-      i = gfc_dep_compare_expr (e1, e2);
+      i = gfc_dep_compare_expr (e1, e2, false);
       if (i == -2)
 	return def;
       else if (i != 0)
@@ -1123,7 +1132,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
 	   && l_stride->ts.type == BT_INTEGER)
     l_dir = mpz_sgn (l_stride->value.integer);
   else if (l_start && l_end)
-    l_dir = gfc_dep_compare_expr (l_end, l_start);
+    l_dir = gfc_dep_compare_expr (l_end, l_start, false);
   else
     l_dir = -2;
 
@@ -1134,7 +1143,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
 	   && r_stride->ts.type == BT_INTEGER)
     r_dir = mpz_sgn (r_stride->value.integer);
   else if (r_start && r_end)
-    r_dir = gfc_dep_compare_expr (r_end, r_start);
+    r_dir = gfc_dep_compare_expr (r_end, r_start, false);
   else
     r_dir = -2;
 
@@ -1152,10 +1161,11 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
   one_expr = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
 
   stride_comparison = gfc_dep_compare_expr (l_stride ? l_stride : one_expr,
-					    r_stride ? r_stride : one_expr);
+					    r_stride ? r_stride : one_expr,
+					    false);
 
   if (l_start && r_start)
-    start_comparison = gfc_dep_compare_expr (l_start, r_start);
+    start_comparison = gfc_dep_compare_expr (l_start, r_start, false);
   else
     start_comparison = -2;
       
@@ -1196,13 +1206,13 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
     }
 
   /* Check whether the ranges are disjoint.  */
-  if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower) == -1)
+  if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower, false) == -1)
     return GFC_DEP_NODEP;
-  if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower) == -1)
+  if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower, false) == -1)
     return GFC_DEP_NODEP;
 
   /* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL.  */
-  if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0)
+  if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start, false) == 0)
     {
       if (l_dir == 1 && r_dir == -1)
 	return GFC_DEP_EQUAL;
@@ -1211,7 +1221,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
     }
 
   /* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL.  */
-  if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 0)
+  if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end, false) == 0)
     {
       if (l_dir == 1 && r_dir == -1)
 	return GFC_DEP_EQUAL;
@@ -1279,7 +1289,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
 	     of low, which is always at least a forward dependence.  */
 
 	  if (r_dir == 1
-	      && gfc_dep_compare_expr (l_start, l_ar->as->lower[n]) == 0)
+	      && gfc_dep_compare_expr (l_start, l_ar->as->lower[n], false) == 0)
 	    return GFC_DEP_FORWARD;
 	}
     }
@@ -1294,7 +1304,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
 	     of high, which is always at least a forward dependence.  */
 
 	  if (r_dir == -1
-	      && gfc_dep_compare_expr (l_start, l_ar->as->upper[n]) == 0)
+	      && gfc_dep_compare_expr (l_start, l_ar->as->upper[n], false) == 0)
 	    return GFC_DEP_FORWARD;
 	}
     }
@@ -1359,19 +1369,19 @@ gfc_check_element_vs_section( gfc_ref *lref, gfc_r
   if (s == 1)
     {
       /* Check for elem < lower.  */
-      if (start && gfc_dep_compare_expr (elem, start) == -1)
+      if (start && gfc_dep_compare_expr (elem, start, false) == -1)
 	return GFC_DEP_NODEP;
       /* Check for elem > upper.  */
-      if (end && gfc_dep_compare_expr (elem, end) == 1)
+      if (end && gfc_dep_compare_expr (elem, end, false) == 1)
 	return GFC_DEP_NODEP;
 
       if (start && end)
 	{
-	  s = gfc_dep_compare_expr (start, end);
+	  s = gfc_dep_compare_expr (start, end, false);
 	  /* Check for an empty range.  */
 	  if (s == 1)
 	    return GFC_DEP_NODEP;
-	  if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
+	  if (s == 0 && gfc_dep_compare_expr (elem, start, false) == 0)
 	    return GFC_DEP_EQUAL;
 	}
     }
@@ -1379,19 +1389,19 @@ gfc_check_element_vs_section( gfc_ref *lref, gfc_r
   else if (s == -1)
     {
       /* Check for elem > upper.  */
-      if (end && gfc_dep_compare_expr (elem, start) == 1)
+      if (end && gfc_dep_compare_expr (elem, start, false) == 1)
 	return GFC_DEP_NODEP;
       /* Check for elem < lower.  */
-      if (start && gfc_dep_compare_expr (elem, end) == -1)
+      if (start && gfc_dep_compare_expr (elem, end, false) == -1)
 	return GFC_DEP_NODEP;
 
       if (start && end)
 	{
-	  s = gfc_dep_compare_expr (start, end);
+	  s = gfc_dep_compare_expr (start, end, false);
 	  /* Check for an empty range.  */
 	  if (s == -1)
 	    return GFC_DEP_NODEP;
-	  if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
+	  if (s == 0 && gfc_dep_compare_expr (elem, start, false) == 0)
 	    return GFC_DEP_EQUAL;
 	}
     }
@@ -1400,33 +1410,33 @@ gfc_check_element_vs_section( gfc_ref *lref, gfc_r
     {
       if (!start || !end)
 	return GFC_DEP_OVERLAP;
-      s = gfc_dep_compare_expr (start, end);
+      s = gfc_dep_compare_expr (start, end, false);
       if (s == -2)
 	return GFC_DEP_OVERLAP;
       /* Assume positive stride.  */
       if (s == -1)
 	{
 	  /* Check for elem < lower.  */
-	  if (gfc_dep_compare_expr (elem, start) == -1)
+	  if (gfc_dep_compare_expr (elem, start, false) == -1)
 	    return GFC_DEP_NODEP;
 	  /* Check for elem > upper.  */
-	  if (gfc_dep_compare_expr (elem, end) == 1)
+	  if (gfc_dep_compare_expr (elem, end, false) == 1)
 	    return GFC_DEP_NODEP;
 	}
       /* Assume negative stride.  */
       else if (s == 1)
 	{
 	  /* Check for elem > upper.  */
-	  if (gfc_dep_compare_expr (elem, start) == 1)
+	  if (gfc_dep_compare_expr (elem, start, false) == 1)
 	    return GFC_DEP_NODEP;
 	  /* Check for elem < lower.  */
-	  if (gfc_dep_compare_expr (elem, end) == -1)
+	  if (gfc_dep_compare_expr (elem, end, false) == -1)
 	    return GFC_DEP_NODEP;
 	}
       /* Equal bounds.  */
       else if (s == 0)
 	{
-	  s = gfc_dep_compare_expr (elem, start);
+	  s = gfc_dep_compare_expr (elem, start, false);
 	  if (s == 0)
 	    return GFC_DEP_EQUAL;
 	  if (s == 1 || s == -1)
@@ -1532,7 +1542,7 @@ gfc_check_element_vs_element (gfc_ref *lref, gfc_r
   r_ar = rref->u.ar;
   l_start = l_ar.start[n] ;
   r_start = r_ar.start[n] ;
-  i = gfc_dep_compare_expr (r_start, l_start);
+  i = gfc_dep_compare_expr (r_start, l_start, false);
   if (i == 0)
     return GFC_DEP_EQUAL;
 
@@ -1607,10 +1617,10 @@ gfc_full_array_ref_p (gfc_ref *ref, bool *contiguo
 	      || !ref->u.ar.as->lower[i]
 	      || !ref->u.ar.as->upper[i]
 	      || gfc_dep_compare_expr (ref->u.ar.as->lower[i],
-				       ref->u.ar.as->upper[i])
+				       ref->u.ar.as->upper[i], false)
 	      || !ref->u.ar.start[i]
 	      || gfc_dep_compare_expr (ref->u.ar.start[i],
-				       ref->u.ar.as->lower[i]))
+				       ref->u.ar.as->lower[i], false))
 	    return false;
 	  else
 	    continue;
@@ -1621,14 +1631,14 @@ gfc_full_array_ref_p (gfc_ref *ref, bool *contiguo
 	  && (!ref->u.ar.as
 	      || !ref->u.ar.as->lower[i]
 	      || gfc_dep_compare_expr (ref->u.ar.start[i],
-				       ref->u.ar.as->lower[i])))
+				       ref->u.ar.as->lower[i], false)))
 	lbound_OK = false;
       /* Check the upper bound.  */
       if (ref->u.ar.end[i]
 	  && (!ref->u.ar.as
 	      || !ref->u.ar.as->upper[i]
 	      || gfc_dep_compare_expr (ref->u.ar.end[i],
-				       ref->u.ar.as->upper[i])))
+				       ref->u.ar.as->upper[i], false)))
 	ubound_OK = false;
       /* Check the stride.  */
       if (ref->u.ar.stride[i]
@@ -1682,10 +1692,10 @@ ref_same_as_full_array (gfc_ref *full_ref, gfc_ref
 	      || !full_ref->u.ar.as->lower[i]
 	      || !full_ref->u.ar.as->upper[i]
 	      || gfc_dep_compare_expr (full_ref->u.ar.as->lower[i],
-				       full_ref->u.ar.as->upper[i])
+				       full_ref->u.ar.as->upper[i], false)
 	      || !ref->u.ar.start[i]
 	      || gfc_dep_compare_expr (ref->u.ar.start[i],
-				       full_ref->u.ar.as->lower[i]))
+				       full_ref->u.ar.as->lower[i], false))
 	    return false;
 	}
 
@@ -1701,14 +1711,14 @@ ref_same_as_full_array (gfc_ref *full_ref, gfc_ref
 	  && (ref->u.ar.as
 	        && full_ref->u.ar.as->lower[i]
 	        && gfc_dep_compare_expr (ref->u.ar.start[i],
-				         full_ref->u.ar.as->lower[i]) == 0))
+				         full_ref->u.ar.as->lower[i], false) == 0))
 	upper_or_lower =  true;
       /* Check the upper bound.  */
       if (ref->u.ar.end[i]
 	  && (ref->u.ar.as
 	        && full_ref->u.ar.as->upper[i]
 	        && gfc_dep_compare_expr (ref->u.ar.end[i],
-				         full_ref->u.ar.as->upper[i]) == 0))
+				         full_ref->u.ar.as->upper[i], false) == 0))
 	upper_or_lower =  true;
       if (!upper_or_lower)
 	return false;

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-04 21:42 [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length Janus Weil
@ 2011-08-05 17:26 ` Mikael Morin
  2011-08-05 17:35   ` Janus Weil
  2011-08-05 21:23 ` Thomas Koenig
  1 sibling, 1 reply; 43+ messages in thread
From: Mikael Morin @ 2011-08-05 17:26 UTC (permalink / raw)
  To: fortran; +Cc: Janus Weil, gcc-patches

On Thursday 04 August 2011 23:42:11 Janus Weil wrote:
> Hi all,
> 
> attached is a draft patch fixing the PR in the subject line and
> extending the checks for overriding type-bound functions. It regtests
> cleanly on x86_64-unknown-linux-gnu already, but I would like to have
> some feedback.
Some quick comments: 

> 
> The patch is rather large, but most of it is just mechanical, due to
> the fact that I added an extra argument to 'gfc_dep_compare_expr'. 
You might want to make the flag an implementation detail, that is keep the 
gfc_dep_compare_expr interface unchanged, but make the function a wrapper 
around the real function with the flag.

> I use this function to compare the string-length expressions of a
> character-valued TBP and an overriding procedure (the standard
> requires them to be equal). Inside 'gfc_dep_compare_expr' I had to add
> a minor piece to correctly respect commutativity of the multiplication
> operator (for the addition operator this was done already). 
OK

> The extra
> argument controls whether we check variable symbols for equality or
> just their names. For the overriding checks it is sufficient to check
> for names, because the arguments of the overriding procedure are
> required to have the same names as in the base procedure.

Unless you extend the flag thing to all the children function of 
gfc_dep_compare_expr (there are zillions of them), it is preferable IMO to 
make the diagnostic a warning, as identical expressions could be missed.

> 
> Moreover I extended the type check in 'check_typebound_override' to
> also check for correct rank, via 'compare_type_rank' instead of
> 'gfc_compare_types'. However, the former was local to interface.c, so
> I made it public (and should probably also rename it to gfc_...),
Yes

> or should one rather move 'check_typebound_override' to interface.c
> itself? I think it fits in there pretty nicely. After all it is
> checking the interfaces of overriding procedures.
Makes sense too. Either is fine.

> 
> Anything else missing for this patch? Or is it ok for trunk? (I will
> add corresponding test cases and a ChangeLog, of course.)
Apart for the error/warning change and the missing tests and ChangeLog, the 
patch is OK.

Mikael

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-05 17:26 ` Mikael Morin
@ 2011-08-05 17:35   ` Janus Weil
  2011-08-05 18:16     ` Mikael Morin
  0 siblings, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-05 17:35 UTC (permalink / raw)
  To: Mikael Morin; +Cc: fortran, gcc-patches

Hi Mikael,

>> The extra
>> argument controls whether we check variable symbols for equality or
>> just their names. For the overriding checks it is sufficient to check
>> for names, because the arguments of the overriding procedure are
>> required to have the same names as in the base procedure.
>
> Unless you extend the flag thing to all the children function of
> gfc_dep_compare_expr (there are zillions of them), it is preferable IMO to
> make the diagnostic a warning, as identical expressions could be missed.

Well, it would not be really satisfying to degrade the error to a
warning, knowing it may be wrong sometimes. So I think one should
rather fix this, which I think is not as hard as you suggest:
gfc_dep_compare_expr doesn't exactly have "zillions" of children, but
just two AFAICS:

 * gfc_are_identical_variables
 * gfc_dep_compare_functions

Apart from those two, it is highly recursive and mostly calls itself,
where the argument is passed on already. So I think it's feasible to
add the extra argument to the above two functions, too (unless anyone
has a better idea).

I'll fix this and send an updated patch soon.

Thanks,
Janus

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-05 17:35   ` Janus Weil
@ 2011-08-05 18:16     ` Mikael Morin
  0 siblings, 0 replies; 43+ messages in thread
From: Mikael Morin @ 2011-08-05 18:16 UTC (permalink / raw)
  To: fortran; +Cc: Janus Weil, gcc-patches

On Friday 05 August 2011 19:30:49 Janus Weil wrote:
> Hi Mikael,
> 
> >> The extra
> >> argument controls whether we check variable symbols for equality or
> >> just their names. For the overriding checks it is sufficient to check
> >> for names, because the arguments of the overriding procedure are
> >> required to have the same names as in the base procedure.
> > 
> > Unless you extend the flag thing to all the children function of
> > gfc_dep_compare_expr (there are zillions of them), it is preferable IMO
> > to make the diagnostic a warning, as identical expressions could be
> > missed.
> 
> Well, it would not be really satisfying to degrade the error to a
> warning, knowing it may be wrong sometimes. So I think one should
> rather fix this, which I think is not as hard as you suggest:
> gfc_dep_compare_expr doesn't exactly have "zillions" of children, but
> just two AFAICS:
> 
>  * gfc_are_identical_variables
gfc_are_identical_variables pulls in identical_array_ref too.
identical_array_ref can pull check_section_vs_section which needs 
gfc_is_same_range. ;-)

>  * gfc_dep_compare_functions
>  
> Apart from those two, it is highly recursive and mostly calls itself,
> where the argument is passed on already. 
Yes, OK there are not zillions of them (I thought almost all of dependency.c 
was pulled in).

> So I think it's feasible to
> add the extra argument to the above two functions, too (unless anyone
> has a better idea).
I still think that there could be some other cases that gfc_dep_compare_expr 
could possibly miss; but they are corner cases if functions and variables refs 
are handled, so an error is IMO OK then. We can wait a bug report to popup 
about it before deciding to downgrade to a warning. 

Mikael

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-04 21:42 [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length Janus Weil
  2011-08-05 17:26 ` Mikael Morin
@ 2011-08-05 21:23 ` Thomas Koenig
  2011-08-05 22:06   ` Mikael Morin
  1 sibling, 1 reply; 43+ messages in thread
From: Thomas Koenig @ 2011-08-05 21:23 UTC (permalink / raw)
  To: Janus Weil; +Cc: gfortran, gcc-patches

Hi Janus,

> The patch is rather large, but most of it is just mechanical, due to
> the fact that I added an extra argument to 'gfc_dep_compare_expr'. I
> use this function to compare the string-length expressions of a
> character-valued TBP and an overriding procedure (the standard
> requires them to be equal).

This will likely introduce rejects-valid bugs.  For example, 
gfc_dep_compare_expr is not able to see that a+b+c equals c+b+a.

What you can do is to raise an error if gfc_dep_compare_expr returns
1 or -1, because then we can prove that the expressions are unequal.
For -2, we just don't know.

>  Inside 'gfc_dep_compare_expr' I had to add
> a minor piece to correctly respect commutativity of the multiplication
> operator (for the addition operator this was done already).

Good idea; maybe you can commit that separately.

> The extra
> argument controls whether we check variable symbols for equality or
> just their names. For the overriding checks it is sufficient to check
> for names, because the arguments of the overriding procedure are
> required to have the same names as in the base procedure.

Could you explain for which cases this test is too strict?

It might also be interesting to see if gfc_are_identical_variables could 
also be relaxed.  Then again, we might get by if we don't treat
-2 from gfc_dep_compare_expr as an error.

> Moreover I extended the type check in 'check_typebound_override' to
> also check for correct rank, via 'compare_type_rank' instead of
> 'gfc_compare_types'. However, the former was local to interface.c, so
> I made it public (and should probably also rename it to gfc_...), or
> should one rather move 'check_typebound_override' to interface.c
> itself? I think it fits in there pretty nicely. After all it is
> checking the interfaces of overriding procedures.

Whatever you choose, please make sure that any global function is
prefixed with gfc_ .

Regards

	Thomas

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-05 21:23 ` Thomas Koenig
@ 2011-08-05 22:06   ` Mikael Morin
  2011-08-06 14:27     ` Janus Weil
  0 siblings, 1 reply; 43+ messages in thread
From: Mikael Morin @ 2011-08-05 22:06 UTC (permalink / raw)
  To: fortran; +Cc: Thomas Koenig, Janus Weil, gcc-patches

On Friday 05 August 2011 23:02:33 Thomas Koenig wrote:
> > The extra
> > argument controls whether we check variable symbols for equality or
> > just their names. For the overriding checks it is sufficient to check
> > for names, because the arguments of the overriding procedure are
> > required to have the same names as in the base procedure.
> 
> Could you explain for which cases this test is too strict?
For dummy arguments. If they are "corresponding" (same position, same name), 
they should compare equal. Cf the PR.

This lets me think that one should enable the comparison by name for dummy 
arguments only. Other variables should compare normally.

Mikael

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-05 22:06   ` Mikael Morin
@ 2011-08-06 14:27     ` Janus Weil
  2011-08-06 16:07       ` Thomas Koenig
  2011-08-06 16:46       ` Janus Weil
  0 siblings, 2 replies; 43+ messages in thread
From: Janus Weil @ 2011-08-06 14:27 UTC (permalink / raw)
  To: Mikael Morin; +Cc: fortran, Thomas Koenig, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 2349 bytes --]

2011/8/5 Mikael Morin <mikael.morin@sfr.fr>:
> On Friday 05 August 2011 23:02:33 Thomas Koenig wrote:
>> > The extra
>> > argument controls whether we check variable symbols for equality or
>> > just their names. For the overriding checks it is sufficient to check
>> > for names, because the arguments of the overriding procedure are
>> > required to have the same names as in the base procedure.
>>
>> Could you explain for which cases this test is too strict?
> For dummy arguments. If they are "corresponding" (same position, same name),
> they should compare equal. Cf the PR.

The string length expressions of overridden procedures have to be
identical, but with exchanged dummy arguments. Since the dummy
arguments of overridden procedures must have the same name as in the
base procedure, it is sufficient the check for equal names. Checking
for equal symbols would be too strict.


> This lets me think that one should enable the comparison by name for dummy
> arguments only. Other variables should compare normally.

Good point. I have attached a new version of the patch, which adds
this constraint, plus:

1) I have moved 'check_typebound_override' to interface.c and prefixed
it with 'gfc_'.

2) I have added the 'var_name_only flag' also to
gfc_are_identical_variables, gfc_dep_compare_functions,
identical_array_ref, check_section_vs_section and gfc_is_same_range. I
hope there is nothing else I missed.

3) I have made 'gfc_are_identical_variables' static and removed the
gfc prefix (it does not seem to be used outside of dependency.c).

4) I have made 'gfc_is_same_range' static and removed the gfc prefix
(there is only a commented out reference to it in trans-array.c, so I
commented out the declaration in dependency.h, too). Also I removed
the 'def' argument, which gets always passed a '0'.

I will regtest this once more, construct some mildly complex test
cases and add a ChangeLog.

In the meantime: Any other objections?

As Thomas mentions, certain cases are still not handled correctly
(e.g. A+B+C vs C+B+A, and other mathematical transformations), but I
hope they are sufficiently exotic (so that we can wait for bug reports
to roll in). In addition I expect people to declare overridden
procedures analogously to the base procedure, and not use e.g.
len=3*(x+1) in one case and len=3*x+3 in the other.

Cheers,
Janus

[-- Attachment #2: pr49638.diff --]
[-- Type: text/x-diff, Size: 42593 bytes --]

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 177507)
+++ gcc/fortran/interface.c	(working copy)
@@ -3466,3 +3466,208 @@ gfc_free_formal_arglist (gfc_formal_arglist *p)
       free (p);
     }
 }
+
+
+/* Check that it is ok for the typebound procedure 'proc' to override the
+   procedure 'old' (F08:4.5.7.3).  */
+
+gfc_try
+gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
+{
+  locus where;
+  const gfc_symbol* proc_target;
+  const gfc_symbol* old_target;
+  unsigned proc_pass_arg, old_pass_arg, argpos;
+  gfc_formal_arglist* proc_formal;
+  gfc_formal_arglist* old_formal;
+
+  /* This procedure should only be called for non-GENERIC proc.  */
+  gcc_assert (!proc->n.tb->is_generic);
+
+  /* If the overwritten procedure is GENERIC, this is an error.  */
+  if (old->n.tb->is_generic)
+    {
+      gfc_error ("Can't overwrite GENERIC '%s' at %L",
+		 old->name, &proc->n.tb->where);
+      return FAILURE;
+    }
+
+  where = proc->n.tb->where;
+  proc_target = proc->n.tb->u.specific->n.sym;
+  old_target = old->n.tb->u.specific->n.sym;
+
+  /* Check that overridden binding is not NON_OVERRIDABLE.  */
+  if (old->n.tb->non_overridable)
+    {
+      gfc_error ("'%s' at %L overrides a procedure binding declared"
+		 " NON_OVERRIDABLE", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* It's an error to override a non-DEFERRED procedure with a DEFERRED one.  */
+  if (!old->n.tb->deferred && proc->n.tb->deferred)
+    {
+      gfc_error ("'%s' at %L must not be DEFERRED as it overrides a"
+		 " non-DEFERRED binding", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is PURE, the overriding must be, too.  */
+  if (old_target->attr.pure && !proc_target->attr.pure)
+    {
+      gfc_error ("'%s' at %L overrides a PURE procedure and must also be PURE",
+		 proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is ELEMENTAL, the overriding must be, too.  If it
+     is not, the overriding must not be either.  */
+  if (old_target->attr.elemental && !proc_target->attr.elemental)
+    {
+      gfc_error ("'%s' at %L overrides an ELEMENTAL procedure and must also be"
+		 " ELEMENTAL", proc->name, &where);
+      return FAILURE;
+    }
+  if (!old_target->attr.elemental && proc_target->attr.elemental)
+    {
+      gfc_error ("'%s' at %L overrides a non-ELEMENTAL procedure and must not"
+		 " be ELEMENTAL, either", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is a SUBROUTINE, the overriding must also be a
+     SUBROUTINE.  */
+  if (old_target->attr.subroutine && !proc_target->attr.subroutine)
+    {
+      gfc_error ("'%s' at %L overrides a SUBROUTINE and must also be a"
+		 " SUBROUTINE", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is a FUNCTION, the overriding must also be a
+     FUNCTION and have the same characteristics.  */
+  if (old_target->attr.function)
+    {
+      if (!proc_target->attr.function)
+	{
+	  gfc_error ("'%s' at %L overrides a FUNCTION and must also be a"
+		     " FUNCTION", proc->name, &where);
+	  return FAILURE;
+	}
+
+      /* FIXME:  Do more comprehensive checking (including, for instance,
+	 the array shape).  */
+      gcc_assert (proc_target->result && old_target->result);
+      if (!compare_type_rank (proc_target->result, old_target->result))
+	{
+	  gfc_error ("'%s' at %L and the overridden FUNCTION should have"
+		     " 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
+	  && gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
+				   old_target->result->ts.u.cl->length,
+				   true) != 0)
+	{
+	  gfc_error ("Character length mismatch between '%s' at '%L' "
+		     "and overridden FUNCTION", proc->name, &where);
+	  return FAILURE;
+	}
+    }
+
+  /* If the overridden binding is PUBLIC, the overriding one must not be
+     PRIVATE.  */
+  if (old->n.tb->access == ACCESS_PUBLIC
+      && proc->n.tb->access == ACCESS_PRIVATE)
+    {
+      gfc_error ("'%s' at %L overrides a PUBLIC procedure and must not be"
+		 " PRIVATE", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* Compare the formal argument lists of both procedures.  This is also abused
+     to find the position of the passed-object dummy arguments of both
+     bindings as at least the overridden one might not yet be resolved and we
+     need those positions in the check below.  */
+  proc_pass_arg = old_pass_arg = 0;
+  if (!proc->n.tb->nopass && !proc->n.tb->pass_arg)
+    proc_pass_arg = 1;
+  if (!old->n.tb->nopass && !old->n.tb->pass_arg)
+    old_pass_arg = 1;
+  argpos = 1;
+  for (proc_formal = proc_target->formal, old_formal = old_target->formal;
+       proc_formal && old_formal;
+       proc_formal = proc_formal->next, old_formal = old_formal->next)
+    {
+      if (proc->n.tb->pass_arg
+	  && !strcmp (proc->n.tb->pass_arg, proc_formal->sym->name))
+	proc_pass_arg = argpos;
+      if (old->n.tb->pass_arg
+	  && !strcmp (old->n.tb->pass_arg, old_formal->sym->name))
+	old_pass_arg = argpos;
+
+      /* Check that the names correspond.  */
+      if (strcmp (proc_formal->sym->name, old_formal->sym->name))
+	{
+	  gfc_error ("Dummy argument '%s' of '%s' at %L should be named '%s' as"
+		     " to match the corresponding argument of the overridden"
+		     " procedure", proc_formal->sym->name, proc->name, &where,
+		     old_formal->sym->name);
+	  return FAILURE;
+	}
+
+      /* Check that the types correspond if neither is the passed-object
+	 argument.  */
+      /* FIXME:  Do more comprehensive testing here.  */
+      if (proc_pass_arg != argpos && old_pass_arg != argpos
+	  && !gfc_compare_types (&proc_formal->sym->ts, &old_formal->sym->ts))
+	{
+	  gfc_error ("Types mismatch for dummy argument '%s' of '%s' %L "
+		     "in respect to the overridden procedure",
+		     proc_formal->sym->name, proc->name, &where);
+	  return FAILURE;
+	}
+
+      ++argpos;
+    }
+  if (proc_formal || old_formal)
+    {
+      gfc_error ("'%s' at %L must have the same number of formal arguments as"
+		 " the overridden procedure", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is NOPASS, the overriding one must also be
+     NOPASS.  */
+  if (old->n.tb->nopass && !proc->n.tb->nopass)
+    {
+      gfc_error ("'%s' at %L overrides a NOPASS binding and must also be"
+		 " NOPASS", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is PASS(x), the overriding one must also be
+     PASS and the passed-object dummy arguments must correspond.  */
+  if (!old->n.tb->nopass)
+    {
+      if (proc->n.tb->nopass)
+	{
+	  gfc_error ("'%s' at %L overrides a binding with PASS and must also be"
+		     " PASS", proc->name, &where);
+	  return FAILURE;
+	}
+
+      if (proc_pass_arg != old_pass_arg)
+	{
+	  gfc_error ("Passed-object dummy argument of '%s' at %L must be at"
+		     " the same position as the passed-object dummy argument of"
+		     " the overridden procedure", proc->name, &where);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(revision 177507)
+++ gcc/fortran/trans-array.c	(working copy)
@@ -3763,7 +3763,7 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop
 		  if (lref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
 		    depends[n] = 2;
 		  else if (! gfc_is_same_range (&lref->u.ar,
-						&rref->u.ar, dim, 0))
+						&rref->u.ar, dim, false))
 		    depends[n] = 1;
 	         }
 
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 177507)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -498,7 +498,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, in
 
   /* If the start and end expressions are equal, the length is one.  */
   if (ref->u.ss.end
-      && gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end) == 0)
+      && gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end, false) == 0)
     tmp = build_int_cst (gfc_charlen_type_node, 1);
   else
     {
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 177507)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2840,6 +2840,7 @@ bool gfc_arglist_matches_symbol (gfc_actual_arglis
 bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
 int gfc_has_vector_subscript (gfc_expr*);
 gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op);
+gfc_try gfc_check_typebound_override (gfc_symtree*, gfc_symtree*);
 
 /* io.c */
 extern gfc_st_label format_asterisk;
@@ -2891,8 +2892,8 @@ void gfc_global_used (gfc_gsymbol *, locus *);
 gfc_namespace* gfc_build_block_ns (gfc_namespace *);
 
 /* dependency.c */
-int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool);
-int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
+int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool, bool);
+int gfc_dep_compare_expr (gfc_expr *, gfc_expr *, bool);
 
 /* check.c */
 gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c	(revision 177507)
+++ gcc/fortran/trans-stmt.c	(working copy)
@@ -2552,7 +2552,7 @@ check_forall_dependencies (gfc_code *c, stmtblock_
 	  break;
 
       if (rref && lref
-	    && gfc_dep_compare_expr (rref->u.ss.start, lref->u.ss.start) < 0)
+	  && gfc_dep_compare_expr (rref->u.ss.start, lref->u.ss.start, false) < 0)
 	{
 	  forall_make_variable_temp (c, pre, post);
 	  need_temp = 0;
Index: gcc/fortran/frontend-passes.c
===================================================================
--- gcc/fortran/frontend-passes.c	(revision 177507)
+++ gcc/fortran/frontend-passes.c	(working copy)
@@ -371,8 +371,8 @@ cfe_expr_0 (gfc_expr **e, int *walk_subtrees,
       newvar = NULL;
       for (j=0; j<i; j++)
 	{
-	  if (gfc_dep_compare_functions(*(expr_array[i]),
-					*(expr_array[j]), true)	== 0)
+	  if (gfc_dep_compare_functions (*(expr_array[i]), *(expr_array[j]),
+					 true, false) == 0)
 	    {
 	      if (newvar == NULL)
 		newvar = create_var (*(expr_array[i]));
@@ -681,7 +681,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
       || (op1->ts.type != BT_REAL && op2->ts.type != BT_REAL
 	  && op1->ts.type != BT_COMPLEX && op2->ts.type != BT_COMPLEX))
     {
-      eq = gfc_dep_compare_expr (op1, op2);
+      eq = gfc_dep_compare_expr (op1, op2, false);
       if (eq == -2)
 	{
 	  /* Replace A // B < A // C with B < C, and A // B < C // B
@@ -695,7 +695,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
 	      gfc_expr *op1_right = op1->value.op.op2;
 	      gfc_expr *op2_right = op2->value.op.op2;
 
-	      if (gfc_dep_compare_expr (op1_left, op2_left) == 0)
+	      if (gfc_dep_compare_expr (op1_left, op2_left, false) == 0)
 		{
 		  /* Watch out for 'A ' // x vs. 'A' // x.  */
 
@@ -722,7 +722,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
 		      return true;
 		    }
 		}
-	      if (gfc_dep_compare_expr (op1_right, op2_right) == 0)
+	      if (gfc_dep_compare_expr (op1_right, op2_right, false) == 0)
 		{
 		  free (op1_right);
 		  free (op2_right);
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 177507)
+++ gcc/fortran/resolve.c	(working copy)
@@ -2585,7 +2585,8 @@ is_scalar_expr_ptr (gfc_expr *expr)
         {
         case REF_SUBSTRING:
           if (ref->u.ss.start == NULL || ref->u.ss.end == NULL
-	      || gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end) != 0)
+	      || gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end,
+				       false) != 0)
 	    retval = FAILURE;
           break;
 
@@ -7139,7 +7140,7 @@ resolve_allocate_deallocate (gfc_code *code, const
 			  gfc_array_ref *par = &(pr->u.ar);
 			  gfc_array_ref *qar = &(qr->u.ar);
 			  if (gfc_dep_compare_expr (par->start[0],
-						    qar->start[0]) != 0)
+						    qar->start[0], false) != 0)
 			      break;
 			}
 		    }
@@ -10672,200 +10673,6 @@ error:
 }
 
 
-/* Check that it is ok for the typebound procedure proc to override the
-   procedure old.  */
-
-static gfc_try
-check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
-{
-  locus where;
-  const gfc_symbol* proc_target;
-  const gfc_symbol* old_target;
-  unsigned proc_pass_arg, old_pass_arg, argpos;
-  gfc_formal_arglist* proc_formal;
-  gfc_formal_arglist* old_formal;
-
-  /* This procedure should only be called for non-GENERIC proc.  */
-  gcc_assert (!proc->n.tb->is_generic);
-
-  /* If the overwritten procedure is GENERIC, this is an error.  */
-  if (old->n.tb->is_generic)
-    {
-      gfc_error ("Can't overwrite GENERIC '%s' at %L",
-		 old->name, &proc->n.tb->where);
-      return FAILURE;
-    }
-
-  where = proc->n.tb->where;
-  proc_target = proc->n.tb->u.specific->n.sym;
-  old_target = old->n.tb->u.specific->n.sym;
-
-  /* Check that overridden binding is not NON_OVERRIDABLE.  */
-  if (old->n.tb->non_overridable)
-    {
-      gfc_error ("'%s' at %L overrides a procedure binding declared"
-		 " NON_OVERRIDABLE", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* It's an error to override a non-DEFERRED procedure with a DEFERRED one.  */
-  if (!old->n.tb->deferred && proc->n.tb->deferred)
-    {
-      gfc_error ("'%s' at %L must not be DEFERRED as it overrides a"
-		 " non-DEFERRED binding", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is PURE, the overriding must be, too.  */
-  if (old_target->attr.pure && !proc_target->attr.pure)
-    {
-      gfc_error ("'%s' at %L overrides a PURE procedure and must also be PURE",
-		 proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is ELEMENTAL, the overriding must be, too.  If it
-     is not, the overriding must not be either.  */
-  if (old_target->attr.elemental && !proc_target->attr.elemental)
-    {
-      gfc_error ("'%s' at %L overrides an ELEMENTAL procedure and must also be"
-		 " ELEMENTAL", proc->name, &where);
-      return FAILURE;
-    }
-  if (!old_target->attr.elemental && proc_target->attr.elemental)
-    {
-      gfc_error ("'%s' at %L overrides a non-ELEMENTAL procedure and must not"
-		 " be ELEMENTAL, either", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is a SUBROUTINE, the overriding must also be a
-     SUBROUTINE.  */
-  if (old_target->attr.subroutine && !proc_target->attr.subroutine)
-    {
-      gfc_error ("'%s' at %L overrides a SUBROUTINE and must also be a"
-		 " SUBROUTINE", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is a FUNCTION, the overriding must also be a
-     FUNCTION and have the same characteristics.  */
-  if (old_target->attr.function)
-    {
-      if (!proc_target->attr.function)
-	{
-	  gfc_error ("'%s' at %L overrides a FUNCTION and must also be a"
-		     " FUNCTION", proc->name, &where);
-	  return FAILURE;
-	}
-
-      /* FIXME:  Do more comprehensive checking (including, for instance, the
-	 rank and array-shape).  */
-      gcc_assert (proc_target->result && old_target->result);
-      if (!gfc_compare_types (&proc_target->result->ts,
-			      &old_target->result->ts))
-	{
-	  gfc_error ("'%s' at %L and the overridden FUNCTION should have"
-		     " matching result types", proc->name, &where);
-	  return FAILURE;
-	}
-    }
-
-  /* If the overridden binding is PUBLIC, the overriding one must not be
-     PRIVATE.  */
-  if (old->n.tb->access == ACCESS_PUBLIC
-      && proc->n.tb->access == ACCESS_PRIVATE)
-    {
-      gfc_error ("'%s' at %L overrides a PUBLIC procedure and must not be"
-		 " PRIVATE", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* Compare the formal argument lists of both procedures.  This is also abused
-     to find the position of the passed-object dummy arguments of both
-     bindings as at least the overridden one might not yet be resolved and we
-     need those positions in the check below.  */
-  proc_pass_arg = old_pass_arg = 0;
-  if (!proc->n.tb->nopass && !proc->n.tb->pass_arg)
-    proc_pass_arg = 1;
-  if (!old->n.tb->nopass && !old->n.tb->pass_arg)
-    old_pass_arg = 1;
-  argpos = 1;
-  for (proc_formal = proc_target->formal, old_formal = old_target->formal;
-       proc_formal && old_formal;
-       proc_formal = proc_formal->next, old_formal = old_formal->next)
-    {
-      if (proc->n.tb->pass_arg
-	  && !strcmp (proc->n.tb->pass_arg, proc_formal->sym->name))
-	proc_pass_arg = argpos;
-      if (old->n.tb->pass_arg
-	  && !strcmp (old->n.tb->pass_arg, old_formal->sym->name))
-	old_pass_arg = argpos;
-
-      /* Check that the names correspond.  */
-      if (strcmp (proc_formal->sym->name, old_formal->sym->name))
-	{
-	  gfc_error ("Dummy argument '%s' of '%s' at %L should be named '%s' as"
-		     " to match the corresponding argument of the overridden"
-		     " procedure", proc_formal->sym->name, proc->name, &where,
-		     old_formal->sym->name);
-	  return FAILURE;
-	}
-
-      /* Check that the types correspond if neither is the passed-object
-	 argument.  */
-      /* FIXME:  Do more comprehensive testing here.  */
-      if (proc_pass_arg != argpos && old_pass_arg != argpos
-	  && !gfc_compare_types (&proc_formal->sym->ts, &old_formal->sym->ts))
-	{
-	  gfc_error ("Types mismatch for dummy argument '%s' of '%s' %L "
-		     "in respect to the overridden procedure",
-		     proc_formal->sym->name, proc->name, &where);
-	  return FAILURE;
-	}
-
-      ++argpos;
-    }
-  if (proc_formal || old_formal)
-    {
-      gfc_error ("'%s' at %L must have the same number of formal arguments as"
-		 " the overridden procedure", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is NOPASS, the overriding one must also be
-     NOPASS.  */
-  if (old->n.tb->nopass && !proc->n.tb->nopass)
-    {
-      gfc_error ("'%s' at %L overrides a NOPASS binding and must also be"
-		 " NOPASS", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is PASS(x), the overriding one must also be
-     PASS and the passed-object dummy arguments must correspond.  */
-  if (!old->n.tb->nopass)
-    {
-      if (proc->n.tb->nopass)
-	{
-	  gfc_error ("'%s' at %L overrides a binding with PASS and must also be"
-		     " PASS", proc->name, &where);
-	  return FAILURE;
-	}
-
-      if (proc_pass_arg != old_pass_arg)
-	{
-	  gfc_error ("Passed-object dummy argument of '%s' at %L must be at"
-		     " the same position as the passed-object dummy argument of"
-		     " the overridden procedure", proc->name, &where);
-	  return FAILURE;
-	}
-    }
-
-  return SUCCESS;
-}
-
-
 /* Check if two GENERIC targets are ambiguous and emit an error is they are.  */
 
 static gfc_try
@@ -11327,11 +11134,14 @@ resolve_typebound_procedure (gfc_symtree* stree)
       overridden = gfc_find_typebound_proc (super_type, NULL,
 					    stree->name, true, NULL);
 
-      if (overridden && overridden->n.tb)
-	stree->n.tb->overridden = overridden->n.tb;
+      if (overridden)
+	{
+	  if (overridden->n.tb)
+	    stree->n.tb->overridden = overridden->n.tb;
 
-      if (overridden && check_typebound_override (stree, overridden) == FAILURE)
-	goto error;
+	  if (gfc_check_typebound_override (stree, overridden) == FAILURE)
+	    goto error;
+	}
     }
 
   /* See if there's a name collision with a component directly in this type.  */
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(revision 177507)
+++ gcc/fortran/check.c	(working copy)
@@ -668,7 +668,7 @@ gfc_var_strlen (const gfc_expr *a)
 	  end_a = mpz_get_si (ra->u.ss.end->value.integer);
 	  return end_a - start_a + 1;
 	}
-      else if (gfc_dep_compare_expr (ra->u.ss.start, ra->u.ss.end) == 0)
+      else if (gfc_dep_compare_expr (ra->u.ss.start, ra->u.ss.end, false) == 0)
 	return 1;
       else
 	return -1;
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c	(revision 177507)
+++ gcc/fortran/dependency.c	(working copy)
@@ -53,7 +53,7 @@ gfc_dependency;
 /* Forward declarations */
 
 static gfc_dependency check_section_vs_section (gfc_array_ref *,
-						gfc_array_ref *, int);
+						gfc_array_ref *, int, bool);
 
 /* Returns 1 if the expr is an integer constant value 1, 0 if it is not or
    def if the value could not be determined.  */
@@ -76,7 +76,7 @@ gfc_expr_is_one (gfc_expr *expr, int def)
    gfc_dep_compare_expr if necessary for comparing array indices.  */
 
 static bool
-identical_array_ref (gfc_array_ref *a1, gfc_array_ref *a2)
+identical_array_ref (gfc_array_ref *a1, gfc_array_ref *a2, bool var_name_only)
 {
   int i;
 
@@ -94,7 +94,7 @@ static bool
 	      || a2->dimen_type[i] != DIMEN_RANGE)
 	    return false;
 
-	  if (check_section_vs_section (a1, a2, i) != GFC_DEP_EQUAL)
+	  if (check_section_vs_section (a1, a2, i, var_name_only) != GFC_DEP_EQUAL)
 	    return false;
 	}
       return true;
@@ -105,7 +105,7 @@ static bool
       gcc_assert (a1->dimen == a2->dimen);
       for (i = 0; i < a1->dimen; i++)
 	{
-	  if (gfc_dep_compare_expr (a1->start[i], a2->start[i]) != 0)
+	  if (gfc_dep_compare_expr (a1->start[i], a2->start[i], var_name_only) != 0)
 	    return false;
 	}
       return true;
@@ -115,17 +115,28 @@ static bool
 
 
 
-/* Return true for identical variables, checking for references if
-   necessary.  Calls identical_array_ref for checking array sections.  */
+/* Return true for identical variables, checking for references if necessary.
+   Calls identical_array_ref for checking array sections. If the flag
+   'var_name_only' is set, then dummy arguments are only checked for equal
+   names, not for symbol equality.  */
 
-bool
-gfc_are_identical_variables (gfc_expr *e1, gfc_expr *e2)
+static bool
+are_identical_variables (gfc_expr *e1, gfc_expr *e2, bool var_name_only)
 {
   gfc_ref *r1, *r2;
+  
+  if (var_name_only
+      && e1->symtree->n.sym->attr.dummy && e2->symtree->n.sym->attr.dummy)
+    {
+      if (e1->symtree->n.sym->name != e2->symtree->n.sym->name)
+	return false;
+    }
+  else
+    {
+      if (e1->symtree->n.sym != e2->symtree->n.sym)
+	return false;
+    }
 
-  if (e1->symtree->n.sym != e2->symtree->n.sym)
-    return false;
-
   /* Volatile variables should never compare equal to themselves.  */
 
   if (e1->symtree->n.sym->attr.volatile_)
@@ -152,7 +163,7 @@ static bool
 	{
 
 	case REF_ARRAY:
-	  if (!identical_array_ref (&r1->u.ar,  &r2->u.ar))
+	  if (!identical_array_ref (&r1->u.ar,  &r2->u.ar, var_name_only))
 	    return false;
 
 	  break;
@@ -163,13 +174,13 @@ static bool
 	  break;
 
 	case REF_SUBSTRING:
-	  if (gfc_dep_compare_expr (r1->u.ss.start, r2->u.ss.start) != 0
-	      || gfc_dep_compare_expr (r1->u.ss.end, r2->u.ss.end) != 0)
+	  if (gfc_dep_compare_expr (r1->u.ss.start, r2->u.ss.start, var_name_only) != 0
+	      || gfc_dep_compare_expr (r1->u.ss.end, r2->u.ss.end, var_name_only) != 0)
 	    return false;
 	  break;
 
 	default:
-	  gfc_internal_error ("gfc_are_identical_variables: Bad type");
+	  gfc_internal_error ("are_identical_variables: Bad type");
 	}
       r1 = r1->next;
       r2 = r2->next;
@@ -181,7 +192,8 @@ static bool
    impure_ok is false, only return 0 for pure functions.  */
 
 int
-gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2, bool impure_ok)
+gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2,
+			   bool impure_ok, bool var_name_only)
 {
 
   gfc_actual_arglist *args1;
@@ -208,7 +220,7 @@ int
 	    return -2;
 	  
 	  if (args1->expr != NULL && args2->expr != NULL
-	      && gfc_dep_compare_expr (args1->expr, args2->expr) != 0)
+	      && gfc_dep_compare_expr (args1->expr, args2->expr, var_name_only) != 0)
 	    return -2;
 	  
 	  args1 = args1->next;
@@ -221,10 +233,12 @@ int
 }
 
 /* Compare two values.  Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2,
-   and -2 if the relationship could not be determined.  */
+   and -2 if the relationship could not be determined.  If 'var_name_only' is
+   true, we only check the variable names for equality, not the symbols
+   themselves.  */
 
 int
-gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
+gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2, bool var_name_only)
 {
   gfc_actual_arglist *args1;
   gfc_actual_arglist *args2;
@@ -258,31 +272,31 @@ int
   if (n1 != NULL)
     {
       if (n2 != NULL)
-	return gfc_dep_compare_expr (n1, n2);
+	return gfc_dep_compare_expr (n1, n2, var_name_only);
       else
-	return gfc_dep_compare_expr (n1, e2);
+	return gfc_dep_compare_expr (n1, e2, var_name_only);
     }
   else
     {
       if (n2 != NULL)
-	return gfc_dep_compare_expr (e1, n2);
+	return gfc_dep_compare_expr (e1, n2, var_name_only);
     }
   
   if (e1->expr_type == EXPR_OP
       && (e1->value.op.op == INTRINSIC_UPLUS
 	  || e1->value.op.op == INTRINSIC_PARENTHESES))
-    return gfc_dep_compare_expr (e1->value.op.op1, e2);
+    return gfc_dep_compare_expr (e1->value.op.op1, e2, var_name_only);
   if (e2->expr_type == EXPR_OP
       && (e2->value.op.op == INTRINSIC_UPLUS
 	  || e2->value.op.op == INTRINSIC_PARENTHESES))
-    return gfc_dep_compare_expr (e1, e2->value.op.op1);
+    return gfc_dep_compare_expr (e1, e2->value.op.op1, var_name_only);
 
   if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
     {
       /* Compare X+C vs. X.  */
       if (e1->value.op.op2->expr_type == EXPR_CONSTANT
 	  && e1->value.op.op2->ts.type == BT_INTEGER
-	  && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
+	  && gfc_dep_compare_expr (e1->value.op.op1, e2, var_name_only) == 0)
 	return mpz_sgn (e1->value.op.op2->value.integer);
 
       /* Compare P+Q vs. R+S.  */
@@ -290,8 +304,8 @@ int
 	{
 	  int l, r;
 
-	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
-	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only);
+	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2, var_name_only);
 	  if (l == 0 && r == 0)
 	    return 0;
 	  if (l == 0 && r != -2)
@@ -303,8 +317,8 @@ int
 	  if (l == -1 && r == -1)
 	    return -1;
 
-	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2);
-	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1);
+	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2, var_name_only);
+	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1, var_name_only);
 	  if (l == 0 && r == 0)
 	    return 0;
 	  if (l == 0 && r != -2)
@@ -323,7 +337,7 @@ int
     {
       if (e2->value.op.op2->expr_type == EXPR_CONSTANT
 	  && e2->value.op.op2->ts.type == BT_INTEGER
-	  && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
+	  && gfc_dep_compare_expr (e1, e2->value.op.op1, var_name_only) == 0)
 	return -mpz_sgn (e2->value.op.op2->value.integer);
     }
 
@@ -332,7 +346,7 @@ int
     {
       if (e1->value.op.op2->expr_type == EXPR_CONSTANT
 	  && e1->value.op.op2->ts.type == BT_INTEGER
-	  && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
+	  && gfc_dep_compare_expr (e1->value.op.op1, e2, var_name_only) == 0)
 	return -mpz_sgn (e1->value.op.op2->value.integer);
 
       /* Compare P-Q vs. R-S.  */
@@ -340,8 +354,8 @@ int
 	{
 	  int l, r;
 
-	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
-	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only);
+	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2, var_name_only);
 	  if (l == 0 && r == 0)
 	    return 0;
 	  if (l != -2 && r == 0)
@@ -362,8 +376,8 @@ int
     {
       int l, r;
 
-      l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
-      r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+      l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only);
+      r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2, var_name_only);
 
       if (l == -2)
 	return -2;
@@ -396,7 +410,7 @@ int
     {
       if (e2->value.op.op2->expr_type == EXPR_CONSTANT
 	  && e2->value.op.op2->ts.type == BT_INTEGER
-	  && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
+	  && gfc_dep_compare_expr (e1, e2->value.op.op1, var_name_only) == 0)
 	return mpz_sgn (e2->value.op.op2->value.integer);
     }
 
@@ -421,7 +435,7 @@ int
       return 1;
 
     case EXPR_VARIABLE:
-      if (gfc_are_identical_variables (e1, e2))
+      if (are_identical_variables (e1, e2, var_name_only))
 	return 0;
       else
 	return -2;
@@ -432,18 +446,22 @@ int
 	return -2;
       if (e1->value.op.op2 == 0)
 	{
-	  i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+	  i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only);
 	  return i == 0 ? 0 : -2;
 	}
-      if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0
-	  && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0)
+      if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1, var_name_only) == 0
+	  && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2, var_name_only) == 0)
 	return 0;
-      /* TODO Handle commutative binary operators here?  */
+      else if (e1->value.op.op == INTRINSIC_TIMES
+	       && gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2, var_name_only) == 0
+	       && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1, var_name_only) == 0)
+	/* Commutativity of multiplication.  */
+	return 0;
+
       return -2;
 
     case EXPR_FUNCTION:
-      return gfc_dep_compare_functions (e1, e2, false);
-      break;
+      return gfc_dep_compare_functions (e1, e2, false, var_name_only);
 
     default:
       return -2;
@@ -451,11 +469,12 @@ int
 }
 
 
-/* Returns 1 if the two ranges are the same, 0 if they are not, and def
-   if the results are indeterminate.  N is the dimension to compare.  */
+/* Returns 1 if the two ranges are the same and 0 if they are not (or if the
+   results are indeterminate). 'n' is the dimension to compare.  */
 
-int
-gfc_is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n, int def)
+static int
+is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2,
+	       int n, bool var_name_only)
 {
   gfc_expr *e1;
   gfc_expr *e2;
@@ -472,25 +491,19 @@ int
   if (e1 && !e2)
     {
       i = gfc_expr_is_one (e1, -1);
-      if (i == -1)
-	return def;
-      else if (i == 0)
+      if (i == -1 || i == 0)
 	return 0;
     }
   else if (e2 && !e1)
     {
       i = gfc_expr_is_one (e2, -1);
-      if (i == -1)
-	return def;
-      else if (i == 0)
+      if (i == -1 || i == 0)
 	return 0;
     }
   else if (e1 && e2)
     {
-      i = gfc_dep_compare_expr (e1, e2);
-      if (i == -2)
-	return def;
-      else if (i != 0)
+      i = gfc_dep_compare_expr (e1, e2, var_name_only);
+      if (i != 0)
 	return 0;
     }
   /* The strides match.  */
@@ -509,12 +522,10 @@ int
 
       /* Check we have values for both.  */
       if (!(e1 && e2))
-	return def;
+	return 0;
 
-      i = gfc_dep_compare_expr (e1, e2);
-      if (i == -2)
-	return def;
-      else if (i != 0)
+      i = gfc_dep_compare_expr (e1, e2, var_name_only);
+      if (i != 0)
 	return 0;
     }
 
@@ -532,12 +543,10 @@ int
 
       /* Check we have values for both.  */
       if (!(e1 && e2))
-	return def;
+	return 0;
 
-      i = gfc_dep_compare_expr (e1, e2);
-      if (i == -2)
-	return def;
-      else if (i != 0)
+      i = gfc_dep_compare_expr (e1, e2, var_name_only);
+      if (i != 0)
 	return 0;
     }
 
@@ -1071,7 +1080,8 @@ gfc_check_dependency (gfc_expr *expr1, gfc_expr *e
 /* Determines overlapping for two array sections.  */
 
 static gfc_dependency
-check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n)
+check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n,
+			  bool var_name_only)
 {
   gfc_expr *l_start;
   gfc_expr *l_end;
@@ -1091,7 +1101,7 @@ static gfc_dependency
   int start_comparison;
 
   /* If they are the same range, return without more ado.  */
-  if (gfc_is_same_range (l_ar, r_ar, n, 0))
+  if (is_same_range (l_ar, r_ar, n, var_name_only))
     return GFC_DEP_EQUAL;
 
   l_start = l_ar->start[n];
@@ -1123,7 +1133,7 @@ static gfc_dependency
 	   && l_stride->ts.type == BT_INTEGER)
     l_dir = mpz_sgn (l_stride->value.integer);
   else if (l_start && l_end)
-    l_dir = gfc_dep_compare_expr (l_end, l_start);
+    l_dir = gfc_dep_compare_expr (l_end, l_start, var_name_only);
   else
     l_dir = -2;
 
@@ -1134,7 +1144,7 @@ static gfc_dependency
 	   && r_stride->ts.type == BT_INTEGER)
     r_dir = mpz_sgn (r_stride->value.integer);
   else if (r_start && r_end)
-    r_dir = gfc_dep_compare_expr (r_end, r_start);
+    r_dir = gfc_dep_compare_expr (r_end, r_start, var_name_only);
   else
     r_dir = -2;
 
@@ -1152,10 +1162,11 @@ static gfc_dependency
   one_expr = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
 
   stride_comparison = gfc_dep_compare_expr (l_stride ? l_stride : one_expr,
-					    r_stride ? r_stride : one_expr);
+					    r_stride ? r_stride : one_expr,
+					    var_name_only);
 
   if (l_start && r_start)
-    start_comparison = gfc_dep_compare_expr (l_start, r_start);
+    start_comparison = gfc_dep_compare_expr (l_start, r_start, var_name_only);
   else
     start_comparison = -2;
       
@@ -1196,13 +1207,13 @@ static gfc_dependency
     }
 
   /* Check whether the ranges are disjoint.  */
-  if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower) == -1)
+  if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower, var_name_only) == -1)
     return GFC_DEP_NODEP;
-  if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower) == -1)
+  if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower, var_name_only) == -1)
     return GFC_DEP_NODEP;
 
   /* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL.  */
-  if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0)
+  if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start, var_name_only) == 0)
     {
       if (l_dir == 1 && r_dir == -1)
 	return GFC_DEP_EQUAL;
@@ -1211,7 +1222,7 @@ static gfc_dependency
     }
 
   /* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL.  */
-  if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 0)
+  if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end, var_name_only) == 0)
     {
       if (l_dir == 1 && r_dir == -1)
 	return GFC_DEP_EQUAL;
@@ -1279,7 +1290,7 @@ static gfc_dependency
 	     of low, which is always at least a forward dependence.  */
 
 	  if (r_dir == 1
-	      && gfc_dep_compare_expr (l_start, l_ar->as->lower[n]) == 0)
+	      && gfc_dep_compare_expr (l_start, l_ar->as->lower[n], var_name_only) == 0)
 	    return GFC_DEP_FORWARD;
 	}
     }
@@ -1294,7 +1305,7 @@ static gfc_dependency
 	     of high, which is always at least a forward dependence.  */
 
 	  if (r_dir == -1
-	      && gfc_dep_compare_expr (l_start, l_ar->as->upper[n]) == 0)
+	      && gfc_dep_compare_expr (l_start, l_ar->as->upper[n], var_name_only) == 0)
 	    return GFC_DEP_FORWARD;
 	}
     }
@@ -1359,19 +1370,19 @@ gfc_check_element_vs_section( gfc_ref *lref, gfc_r
   if (s == 1)
     {
       /* Check for elem < lower.  */
-      if (start && gfc_dep_compare_expr (elem, start) == -1)
+      if (start && gfc_dep_compare_expr (elem, start, false) == -1)
 	return GFC_DEP_NODEP;
       /* Check for elem > upper.  */
-      if (end && gfc_dep_compare_expr (elem, end) == 1)
+      if (end && gfc_dep_compare_expr (elem, end, false) == 1)
 	return GFC_DEP_NODEP;
 
       if (start && end)
 	{
-	  s = gfc_dep_compare_expr (start, end);
+	  s = gfc_dep_compare_expr (start, end, false);
 	  /* Check for an empty range.  */
 	  if (s == 1)
 	    return GFC_DEP_NODEP;
-	  if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
+	  if (s == 0 && gfc_dep_compare_expr (elem, start, false) == 0)
 	    return GFC_DEP_EQUAL;
 	}
     }
@@ -1379,19 +1390,19 @@ gfc_check_element_vs_section( gfc_ref *lref, gfc_r
   else if (s == -1)
     {
       /* Check for elem > upper.  */
-      if (end && gfc_dep_compare_expr (elem, start) == 1)
+      if (end && gfc_dep_compare_expr (elem, start, false) == 1)
 	return GFC_DEP_NODEP;
       /* Check for elem < lower.  */
-      if (start && gfc_dep_compare_expr (elem, end) == -1)
+      if (start && gfc_dep_compare_expr (elem, end, false) == -1)
 	return GFC_DEP_NODEP;
 
       if (start && end)
 	{
-	  s = gfc_dep_compare_expr (start, end);
+	  s = gfc_dep_compare_expr (start, end, false);
 	  /* Check for an empty range.  */
 	  if (s == -1)
 	    return GFC_DEP_NODEP;
-	  if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
+	  if (s == 0 && gfc_dep_compare_expr (elem, start, false) == 0)
 	    return GFC_DEP_EQUAL;
 	}
     }
@@ -1400,33 +1411,33 @@ gfc_check_element_vs_section( gfc_ref *lref, gfc_r
     {
       if (!start || !end)
 	return GFC_DEP_OVERLAP;
-      s = gfc_dep_compare_expr (start, end);
+      s = gfc_dep_compare_expr (start, end, false);
       if (s == -2)
 	return GFC_DEP_OVERLAP;
       /* Assume positive stride.  */
       if (s == -1)
 	{
 	  /* Check for elem < lower.  */
-	  if (gfc_dep_compare_expr (elem, start) == -1)
+	  if (gfc_dep_compare_expr (elem, start, false) == -1)
 	    return GFC_DEP_NODEP;
 	  /* Check for elem > upper.  */
-	  if (gfc_dep_compare_expr (elem, end) == 1)
+	  if (gfc_dep_compare_expr (elem, end, false) == 1)
 	    return GFC_DEP_NODEP;
 	}
       /* Assume negative stride.  */
       else if (s == 1)
 	{
 	  /* Check for elem > upper.  */
-	  if (gfc_dep_compare_expr (elem, start) == 1)
+	  if (gfc_dep_compare_expr (elem, start, false) == 1)
 	    return GFC_DEP_NODEP;
 	  /* Check for elem < lower.  */
-	  if (gfc_dep_compare_expr (elem, end) == -1)
+	  if (gfc_dep_compare_expr (elem, end, false) == -1)
 	    return GFC_DEP_NODEP;
 	}
       /* Equal bounds.  */
       else if (s == 0)
 	{
-	  s = gfc_dep_compare_expr (elem, start);
+	  s = gfc_dep_compare_expr (elem, start, false);
 	  if (s == 0)
 	    return GFC_DEP_EQUAL;
 	  if (s == 1 || s == -1)
@@ -1532,7 +1543,7 @@ gfc_check_element_vs_element (gfc_ref *lref, gfc_r
   r_ar = rref->u.ar;
   l_start = l_ar.start[n] ;
   r_start = r_ar.start[n] ;
-  i = gfc_dep_compare_expr (r_start, l_start);
+  i = gfc_dep_compare_expr (r_start, l_start, false);
   if (i == 0)
     return GFC_DEP_EQUAL;
 
@@ -1607,10 +1618,10 @@ gfc_full_array_ref_p (gfc_ref *ref, bool *contiguo
 	      || !ref->u.ar.as->lower[i]
 	      || !ref->u.ar.as->upper[i]
 	      || gfc_dep_compare_expr (ref->u.ar.as->lower[i],
-				       ref->u.ar.as->upper[i])
+				       ref->u.ar.as->upper[i], false)
 	      || !ref->u.ar.start[i]
 	      || gfc_dep_compare_expr (ref->u.ar.start[i],
-				       ref->u.ar.as->lower[i]))
+				       ref->u.ar.as->lower[i], false))
 	    return false;
 	  else
 	    continue;
@@ -1621,14 +1632,14 @@ gfc_full_array_ref_p (gfc_ref *ref, bool *contiguo
 	  && (!ref->u.ar.as
 	      || !ref->u.ar.as->lower[i]
 	      || gfc_dep_compare_expr (ref->u.ar.start[i],
-				       ref->u.ar.as->lower[i])))
+				       ref->u.ar.as->lower[i], false)))
 	lbound_OK = false;
       /* Check the upper bound.  */
       if (ref->u.ar.end[i]
 	  && (!ref->u.ar.as
 	      || !ref->u.ar.as->upper[i]
 	      || gfc_dep_compare_expr (ref->u.ar.end[i],
-				       ref->u.ar.as->upper[i])))
+				       ref->u.ar.as->upper[i], false)))
 	ubound_OK = false;
       /* Check the stride.  */
       if (ref->u.ar.stride[i]
@@ -1682,10 +1693,10 @@ ref_same_as_full_array (gfc_ref *full_ref, gfc_ref
 	      || !full_ref->u.ar.as->lower[i]
 	      || !full_ref->u.ar.as->upper[i]
 	      || gfc_dep_compare_expr (full_ref->u.ar.as->lower[i],
-				       full_ref->u.ar.as->upper[i])
+				       full_ref->u.ar.as->upper[i], false)
 	      || !ref->u.ar.start[i]
 	      || gfc_dep_compare_expr (ref->u.ar.start[i],
-				       full_ref->u.ar.as->lower[i]))
+				       full_ref->u.ar.as->lower[i], false))
 	    return false;
 	}
 
@@ -1701,14 +1712,14 @@ ref_same_as_full_array (gfc_ref *full_ref, gfc_ref
 	  && (ref->u.ar.as
 	        && full_ref->u.ar.as->lower[i]
 	        && gfc_dep_compare_expr (ref->u.ar.start[i],
-				         full_ref->u.ar.as->lower[i]) == 0))
+				         full_ref->u.ar.as->lower[i], false) == 0))
 	upper_or_lower =  true;
       /* Check the upper bound.  */
       if (ref->u.ar.end[i]
 	  && (ref->u.ar.as
 	        && full_ref->u.ar.as->upper[i]
 	        && gfc_dep_compare_expr (ref->u.ar.end[i],
-				         full_ref->u.ar.as->upper[i]) == 0))
+				         full_ref->u.ar.as->upper[i], false) == 0))
 	upper_or_lower =  true;
       if (!upper_or_lower)
 	return false;
@@ -1787,7 +1798,7 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gf
 
 	      if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
 		  && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
-		this_dep = check_section_vs_section (&lref->u.ar, &rref->u.ar, n);
+		this_dep = check_section_vs_section (&lref->u.ar, &rref->u.ar, n, false);
 	      else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
 		       && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
 		this_dep = gfc_check_element_vs_section (lref, rref, n);
Index: gcc/fortran/dependency.h
===================================================================
--- gcc/fortran/dependency.h	(revision 177507)
+++ gcc/fortran/dependency.h	(working copy)
@@ -37,11 +37,8 @@ gfc_expr *gfc_get_noncopying_intrinsic_argument (g
 int gfc_check_fncall_dependency (gfc_expr *, sym_intent, gfc_symbol *,
 				 gfc_actual_arglist *, gfc_dep_check);
 int gfc_check_dependency (gfc_expr *, gfc_expr *, bool);
-int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, int);
+/*int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, bool);*/
 int gfc_expr_is_one (gfc_expr *, int);
 
 int gfc_dep_resolver(gfc_ref *, gfc_ref *, gfc_reverse *);
 int gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
-
-bool gfc_are_identical_variables (gfc_expr *, gfc_expr *);
-

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 14:27     ` Janus Weil
@ 2011-08-06 16:07       ` Thomas Koenig
  2011-08-06 16:17         ` Mikael Morin
  2011-08-06 16:45         ` Janus Weil
  2011-08-06 16:46       ` Janus Weil
  1 sibling, 2 replies; 43+ messages in thread
From: Thomas Koenig @ 2011-08-06 16:07 UTC (permalink / raw)
  To: Janus Weil; +Cc: Mikael Morin, fortran, gcc-patches

Hi Janus,

> 2011/8/5 Mikael Morin<mikael.morin@sfr.fr>:
>> On Friday 05 August 2011 23:02:33 Thomas Koenig wrote:
>>>> The extra
>>>> argument controls whether we check variable symbols for equality or
>>>> just their names. For the overriding checks it is sufficient to check
>>>> for names, because the arguments of the overriding procedure are
>>>> required to have the same names as in the base procedure.
>>>
>>> Could you explain for which cases this test is too strict?
>> For dummy arguments. If they are "corresponding" (same position, same name),
>> they should compare equal. Cf the PR.
>
> The string length expressions of overridden procedures have to be
> identical, but with exchanged dummy arguments. Since the dummy
> arguments of overridden procedures must have the same name as in the
> base procedure, it is sufficient the check for equal names. Checking
> for equal symbols would be too strict.


I just tested the following patch:

Index: dependency.c
===================================================================
--- dependency.c        (Revision 177487)
+++ dependency.c        (Arbeitskopie)
@@ -123,7 +123,7 @@ gfc_are_identical_variables (gfc_expr *e1, gfc_exp
  {
    gfc_ref *r1, *r2;

-  if (e1->symtree->n.sym != e2->symtree->n.sym)
+  if (strcmp(e1->symtree->n.sym->name, e2->symtree->n.sym->name))
      return false;

    /* Volatile variables should never compare equal to themselves.  */

without any regressions.  Can anybody think of a case where the names 
can be identical, but the variables different?  (I can't).

Maybe we can relax the test that way and get rid of the large number
of changes for gfc_dep_compare_expr everywhere (which I confess I
dislike, but I can hardly find fault with something that I have done
only yesterday, although the number of changes was much smaller there :-)


> 1) I have moved 'check_typebound_override' to interface.c and prefixed
> it with 'gfc_'.

OK.

> 2) I have added the 'var_name_only flag' also to
> gfc_are_identical_variables, gfc_dep_compare_functions,
> identical_array_ref, check_section_vs_section and gfc_is_same_range. I
> hope there is nothing else I missed.

See above; could we avoid that?

> 3) I have made 'gfc_are_identical_variables' static and removed the
> gfc prefix (it does not seem to be used outside of dependency.c).

OK.

> 4) I have made 'gfc_is_same_range' static and removed the gfc prefix
> (there is only a commented out reference to it in trans-array.c, so I
> commented out the declaration in dependency.h, too). Also I removed
> the 'def' argument, which gets always passed a '0'.

OK.


> As Thomas mentions, certain cases are still not handled correctly
> (e.g. A+B+C vs C+B+A, and other mathematical transformations), but I
> hope they are sufficiently exotic (so that we can wait for bug reports
> to roll in). In addition I expect people to declare overridden
> procedures analogously to the base procedure, and not use e.g.
> len=3*(x+1) in one case and len=3*x+3 in the other.

Not OK.

It is wrong to assume that expressions are unequal because we cannot
prove they are equal, with all the limitations that we currently
have.  This will introduce rejects-valid bugs.

Please change

+      /* Check string length.  */
+      if (proc_target->result->ts.type == BT_CHARACTER
+	  && proc_target->result->ts.u.cl && old_target->result->ts.u.cl
+	  && gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
+				   old_target->result->ts.u.cl->length,
+				   true) != 0)

to something like (untested)

+      /* Check string length.  */
+      if (proc_target->result->ts.type == BT_CHARACTER
+	  && proc_target->result->ts.u.cl && old_target->result->ts.u.cl
+         {
+            int len_comparision;
+            len_comparison = gfc_dep_compare_expr 
(proc_target->result->ts.u.cl->length,
+				  old_target->result->ts.u.cl->length);
+            if (len_comparison != 0 && len_comparison != -2)
          ...

Alternatively, you could raise an error for 1 and -1 and warn only for
-2 (... may be different).

Regards

	Thomas

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 16:07       ` Thomas Koenig
@ 2011-08-06 16:17         ` Mikael Morin
  2011-08-06 16:24           ` Janus Weil
  2011-08-06 16:45         ` Janus Weil
  1 sibling, 1 reply; 43+ messages in thread
From: Mikael Morin @ 2011-08-06 16:17 UTC (permalink / raw)
  To: fortran; +Cc: Thomas Koenig, Janus Weil, gcc-patches

On Saturday 06 August 2011 17:39:06 Thomas Koenig wrote:
> > As Thomas mentions, certain cases are still not handled correctly
> > (e.g. A+B+C vs C+B+A, and other mathematical transformations), but I
> > hope they are sufficiently exotic (so that we can wait for bug reports
> > to roll in). In addition I expect people to declare overridden
> > procedures analogously to the base procedure, and not use e.g.
> > len=3*(x+1) in one case and len=3*x+3 in the other.
> 
> Not OK.
> 
> It is wrong to assume that expressions are unequal because we cannot
> prove they are equal, with all the limitations that we currently
> have.  This will introduce rejects-valid bugs.
In the PR at
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=49638#c8
I quote the standard:

4.5.7.3 (type-bound procedure overriding) has:
• Either both shall be subroutines or both shall be functions having the same
result characteristics (12.3.3).

12.3.3 (Characteristics of function results):
If a type parameter of a function result or a bound of a function result array
is not a constant expression, the
exact dependence on the entities in the expression is a characteristic


So the standards is more restrictive than expression values being the same. It 
requires _the exact same dependence on the entities_. My reading of this is 
that 3*(x+1) vs 3*x+3 is right to be rejected, same for (a+b)+c vs a+(b+c). 
The only worrying case that I see is the one you pointed out: a+b+c vs c+b+a 
(without brackets).


Mikael

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 16:17         ` Mikael Morin
@ 2011-08-06 16:24           ` Janus Weil
  2011-08-06 16:59             ` Mikael Morin
  0 siblings, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-06 16:24 UTC (permalink / raw)
  To: Mikael Morin; +Cc: fortran, Thomas Koenig, gcc-patches

>> It is wrong to assume that expressions are unequal because we cannot
>> prove they are equal, with all the limitations that we currently
>> have.  This will introduce rejects-valid bugs.
> In the PR at
> http://gcc.gnu.org/bugzilla/show_bug.cgi?id=49638#c8
> I quote the standard:
>
> 4.5.7.3 (type-bound procedure overriding) has:
> • Either both shall be subroutines or both shall be functions having the same
> result characteristics (12.3.3).
>
> 12.3.3 (Characteristics of function results):
> If a type parameter of a function result or a bound of a function result array
> is not a constant expression, the
> exact dependence on the entities in the expression is a characteristic
>
>
> So the standards is more restrictive than expression values being the same. It
> requires _the exact same dependence on the entities_. My reading of this is
> that 3*(x+1) vs 3*x+3 is right to be rejected, same for (a+b)+c vs a+(b+c).
> The only worrying case that I see is the one you pointed out: a+b+c vs c+b+a
> (without brackets).

Huh, I don't see what is so different between

1) 3*(x+1)   vs  3*x+3   and
2) a+b+c  vs  c+b+a

In both cases the expressions look different at first sight, but can
be transformed into each other mathematically. So I'd say they are
mathematically equivalent, although the spelled-out representations of
these expressions differ.

The question is how you interpret the standard's formulation of "exact
dependence on the entities in the expression". Naively I would have
taken this to mean the *mathematical* dependence (which can be
represented by different actual expressions). But I'm fine with your
interpretation, too, which will make life even easier for us.

Cheers,
Janus

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 16:24           ` Janus Weil
@ 2011-08-06 16:59             ` Mikael Morin
  2011-08-06 18:42               ` Steve Kargl
  0 siblings, 1 reply; 43+ messages in thread
From: Mikael Morin @ 2011-08-06 16:59 UTC (permalink / raw)
  To: fortran; +Cc: Janus Weil, Thomas Koenig, gcc-patches

On Saturday 06 August 2011 18:06:58 Janus Weil wrote:
> >> It is wrong to assume that expressions are unequal because we cannot
> >> prove they are equal, with all the limitations that we currently
> >> have.  This will introduce rejects-valid bugs.
> > 
> > In the PR at
> > http://gcc.gnu.org/bugzilla/show_bug.cgi?id=49638#c8
> > I quote the standard:
> > 
> > 4.5.7.3 (type-bound procedure overriding) has:
> > • Either both shall be subroutines or both shall be functions having the
> > same result characteristics (12.3.3).
> > 
> > 12.3.3 (Characteristics of function results):
> > If a type parameter of a function result or a bound of a function result
> > array is not a constant expression, the
> > exact dependence on the entities in the expression is a characteristic
> > 
> > 
> > So the standards is more restrictive than expression values being the
> > same. It requires _the exact same dependence on the entities_. My
> > reading of this is that 3*(x+1) vs 3*x+3 is right to be rejected, same
> > for (a+b)+c vs a+(b+c). The only worrying case that I see is the one you
> > pointed out: a+b+c vs c+b+a (without brackets).
> 
> Huh, I don't see what is so different between
> 
> 1) 3*(x+1)   vs  3*x+3   and
> 2) a+b+c  vs  c+b+a
> 
> In both cases the expressions look different at first sight, but can
> be transformed into each other mathematically. So I'd say they are
> mathematically equivalent, although the spelled-out representations of
> these expressions differ.
I was looking at the standard, because I was not so sure myself.
Here is what is written (7.1.5.2.4):

Once the interpretation of a numeric intrinsic operation is established, the 
processor may evaluate any mathematically equivalent expression, provided that 
the integrity of parentheses is not violated.

Two expressions of a numeric type are mathematically equivalent if, for all 
possible values of their primaries, theirmathematical values are equal.


So parentheses have to be respected; other than that anything is possible.
This is about the evaluation of expressions though, not about the "dependences 
on entities".


> 
> The question is how you interpret the standard's formulation of "exact
> dependence on the entities in the expression". 
That is the question.

> Naively I would have
> taken this to mean the *mathematical* dependence (which can be
> represented by different actual expressions). But I'm fine with your
> interpretation, too, which will make life even easier for us.
Yes, my interpretation is somewhat biased towards ease of implementation. ;-)


Mikael

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 16:59             ` Mikael Morin
@ 2011-08-06 18:42               ` Steve Kargl
  0 siblings, 0 replies; 43+ messages in thread
From: Steve Kargl @ 2011-08-06 18:42 UTC (permalink / raw)
  To: Mikael Morin; +Cc: fortran, Janus Weil, Thomas Koenig, gcc-patches

On Sat, Aug 06, 2011 at 06:45:36PM +0200, Mikael Morin wrote:
> On Saturday 06 August 2011 18:06:58 Janus Weil wrote:
> > >> It is wrong to assume that expressions are unequal because we cannot
> > >> prove they are equal, with all the limitations that we currently
> > >> have.  This will introduce rejects-valid bugs.
> > > 
> > > In the PR at
> > > http://gcc.gnu.org/bugzilla/show_bug.cgi?id=49638#c8
> > > I quote the standard:
> > > 
> > > 4.5.7.3 (type-bound procedure overriding) has:
> > > ? Either both shall be subroutines or both shall be functions having the
> > > same result characteristics (12.3.3).
> > > 
> > > 12.3.3 (Characteristics of function results):
> > > If a type parameter of a function result or a bound of a function result
> > > array is not a constant expression, the
> > > exact dependence on the entities in the expression is a characteristic
> > > 
> > > 
> > > So the standards is more restrictive than expression values being the
> > > same. It requires _the exact same dependence on the entities_. My
> > > reading of this is that 3*(x+1) vs 3*x+3 is right to be rejected, same
> > > for (a+b)+c vs a+(b+c). The only worrying case that I see is the one you
> > > pointed out: a+b+c vs c+b+a (without brackets).
> > 
> > Huh, I don't see what is so different between
> > 
> > 1) 3*(x+1)   vs  3*x+3   and
> > 2) a+b+c  vs  c+b+a
> > 
> > In both cases the expressions look different at first sight, but can
> > be transformed into each other mathematically. So I'd say they are
> > mathematically equivalent, although the spelled-out representations of
> > these expressions differ.
> I was looking at the standard, because I was not so sure myself.
> Here is what is written (7.1.5.2.4):
> 
> Once the interpretation of a numeric intrinsic operation is established, the 
> processor may evaluate any mathematically equivalent expression, provided that 
> the integrity of parentheses is not violated.
> 
> Two expressions of a numeric type are mathematically equivalent if, for all 
> possible values of their primaries, theirmathematical values are equal.
> 
> 
> So parentheses have to be respected; other than that anything is possible.

See Note 7.18.  X*(Y-Z) -> X*Y - X*Z is a forbidden transformation
(there is no noted restriction on Z > 0).

a + b + c -> b + a + c -> b + (a + c) is a sequence of allowable
transformations.
 
-- 
Steve

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 16:07       ` Thomas Koenig
  2011-08-06 16:17         ` Mikael Morin
@ 2011-08-06 16:45         ` Janus Weil
  2011-08-06 16:54           ` Thomas Koenig
  1 sibling, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-06 16:45 UTC (permalink / raw)
  To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches

Hi Thomas,


>> The string length expressions of overridden procedures have to be
>> identical, but with exchanged dummy arguments. Since the dummy
>> arguments of overridden procedures must have the same name as in the
>> base procedure, it is sufficient the check for equal names. Checking
>> for equal symbols would be too strict.
>
>
> I just tested the following patch:
>
> Index: dependency.c
> ===================================================================
> --- dependency.c        (Revision 177487)
> +++ dependency.c        (Arbeitskopie)
> @@ -123,7 +123,7 @@ gfc_are_identical_variables (gfc_expr *e1, gfc_exp
>  {
>   gfc_ref *r1, *r2;
>
> -  if (e1->symtree->n.sym != e2->symtree->n.sym)
> +  if (strcmp(e1->symtree->n.sym->name, e2->symtree->n.sym->name))
>     return false;
>
>   /* Volatile variables should never compare equal to themselves.  */
>
> without any regressions.  Can anybody think of a case where the names can be
> identical, but the variables different?  (I can't).

Well, I'd say this can only happen if both variables reside in
different namespaces (i.e. different modules or procedures).


> Maybe we can relax the test that way and get rid of the large number
> of changes for gfc_dep_compare_expr everywhere (which I confess I
> dislike, but I can hardly find fault with something that I have done
> only yesterday, although the number of changes was much smaller there :-)

Ok, I don't like the large number of changes either, but I assumed
they were necessary.

I have to admit I'm not aware of all the cases that
'gfc_dep_compare_expr' was intended for originally. I was only trying
to re-use it for checking overriding procedures, which seems to work
very well, except for the "variable names vs. symbols" issue. If you
tell me it's fine to only check for variable names everywhere, this is
of course fine.

Btw, the fact that your patch has no regressions does not necessarily
mean that there are no cases where it could fail. It could just mean
that the testsuite does not cover these cases.

Cheers,
Janus

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 16:45         ` Janus Weil
@ 2011-08-06 16:54           ` Thomas Koenig
  2011-08-06 17:10             ` Janus Weil
  0 siblings, 1 reply; 43+ messages in thread
From: Thomas Koenig @ 2011-08-06 16:54 UTC (permalink / raw)
  To: Janus Weil; +Cc: Mikael Morin, fortran, gcc-patches

Am 06.08.2011 18:16, schrieb Janus Weil:
>> without any regressions.  Can anybody think of a case where the names can be
>> >  identical, but the variables different?  (I can't).
> Well, I'd say this can only happen if both variables reside in
> different namespaces (i.e. different modules or procedures).
>

gfc_are_identical variables is only called from within 
gfc_dep_compare_expr.  It makes no sense to call this function
to compare expressions from different statements, unless one has 
carefully analyzed that no intervening assignment to the variables has 
taken place.  Comparing across namespaces makes even less sense.

So yes, I think it is enough if we compare the variable names, and
document this in a commtent.

 > I have to admit I'm not aware of all the cases that
 > 'gfc_dep_compare_expr' was intended for originally. I was only trying
 > to re-use it for checking overriding procedures, which seems to work
 > very well, except for the "variable names vs. symbols" issue. If you
 > tell me it's fine to only check for variable names everywhere, this is
 > of course fine.

Well,  I also wrote the function, so maybe I can claim a little bit of
authority here on the way it was originally meant to be ;-)

 > Btw, the fact that your patch has no regressions does not necessarily
 > mean that there are no cases where it could fail. It could just mean
 > that the testsuite does not cover these cases.

Of course.  However, when analysis and regression test agree, it is 
usually a good sign :-)





^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 16:54           ` Thomas Koenig
@ 2011-08-06 17:10             ` Janus Weil
  2011-08-06 17:40               ` Janus Weil
  0 siblings, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-06 17:10 UTC (permalink / raw)
  To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches

>>> without any regressions.  Can anybody think of a case where the names can
>>> be
>>> >  identical, but the variables different?  (I can't).
>>
>> Well, I'd say this can only happen if both variables reside in
>> different namespaces (i.e. different modules or procedures).
>>
>
> gfc_are_identical variables is only called from within gfc_dep_compare_expr.
>  It makes no sense to call this function
> to compare expressions from different statements, unless one has carefully
> analyzed that no intervening assignment to the variables has taken place.
>  Comparing across namespaces makes even less sense.
>
> So yes, I think it is enough if we compare the variable names, and
> document this in a commtent.

Actually, on second thought, I disagree.

For the original usage cases of gfc_dep_compare_expr, I'm not sure if
one can guarantee the expressions to be in the same namespace.

However, for the overriding checks, both expressions are guaranteed to
be in *different* namespaces (namely: two different procedures). And
as Mikael noted, it is crucial wether the symbols in the expressions
are dummy arguments or not:

1) Dummies are guaranteed to have equal names in overridden
procedures, so we can just compare names.

2) Non-dummies could have the same name, but still sit in different
namespaces, so for them we really have to check for equal symbols!


Here is a variant of the original test case from the PR, which will be
accepted if we only check for names (but it should actually be
rejected):


module world

  implicit none

  type :: world_1
   contains
     procedure, nopass :: string => w1_string
  end type

  type, extends(world_1) :: world_2
   contains
     procedure, nopass :: string => w2_string
  end type

contains

  function w1_string (m)
    integer, parameter :: n = 5
    integer, intent(in) :: m
    character(n+m) :: w1_string
    w1_string = "world"
  end function

  function w2_string (m)
    integer, parameter :: n = 6
    integer, intent(in) :: m
    character(n+m) :: w2_string
    w2_string = "world2"
  end function

end module


Cheers,
Janus

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 17:10             ` Janus Weil
@ 2011-08-06 17:40               ` Janus Weil
  2011-08-06 18:27                 ` Mikael Morin
  0 siblings, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-06 17:40 UTC (permalink / raw)
  To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches

> Here is a variant of the original test case from the PR, which will be
> accepted if we only check for names (but it should actually be
> rejected):
>
>
> module world
>
>  implicit none
>
>  type :: world_1
>   contains
>     procedure, nopass :: string => w1_string
>  end type
>
>  type, extends(world_1) :: world_2
>   contains
>     procedure, nopass :: string => w2_string
>  end type
>
> contains
>
>  function w1_string (m)
>    integer, parameter :: n = 5
>    integer, intent(in) :: m
>    character(n+m) :: w1_string
>    w1_string = "world"
>  end function
>
>  function w2_string (m)
>    integer, parameter :: n = 6
>    integer, intent(in) :: m
>    character(n+m) :: w2_string
>    w2_string = "world2"
>  end function
>
> end module

Sorry, now I have to disagree with my own earlier claims: In this
example, the 'n' variables will of course be simplified to
EXPR_CONSTANTs, so the name checking does not apply to them.

And since the string length can not depend on local variables which
are *not* constant, name checking should still be fine!

Now, if Thomas says it's fine for the other cases, too, then it seems
we can really get away with a much simpler patch. Hope we're not
missing anything, though ...

Cheers,
Janus

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 17:40               ` Janus Weil
@ 2011-08-06 18:27                 ` Mikael Morin
  2011-08-06 18:37                   ` Janus Weil
  0 siblings, 1 reply; 43+ messages in thread
From: Mikael Morin @ 2011-08-06 18:27 UTC (permalink / raw)
  To: fortran; +Cc: Janus Weil, Thomas Koenig, gcc-patches

On Saturday 06 August 2011 19:10:09 Janus Weil wrote:
> Now, if Thomas says it's fine for the other cases, too, then it seems
> we can really get away with a much simpler patch. Hope we're not
> missing anything, though ...
> 

What about this case: two module variables from two different modules?




module world1

 implicit none

 integer :: n

 type :: t1
  contains
    procedure, nopass :: string => w1_string
 end type

contains

 function w1_string (m)
   integer, intent(in) :: m
   character(n) :: w1_string
   w1_string = "world"
 end function


end module world1


module world2 

 use world1, only : t1

 implicit none

 integer :: n

 type, extends(t1) :: t2
  contains
    procedure, nopass :: string => w2_string
 end type

contains

 function w2_string (m)
   integer, intent(in) :: m
   character(n) :: w2_string
   w2_string = "world2"
 end function

end module world2
 

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 18:27                 ` Mikael Morin
@ 2011-08-06 18:37                   ` Janus Weil
  2011-08-06 20:32                     ` Thomas Koenig
  0 siblings, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-06 18:37 UTC (permalink / raw)
  To: Mikael Morin; +Cc: fortran, Thomas Koenig, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 543 bytes --]

2011/8/6 Mikael Morin <mikael.morin@sfr.fr>:
> On Saturday 06 August 2011 19:10:09 Janus Weil wrote:
>> Now, if Thomas says it's fine for the other cases, too, then it seems
>> we can really get away with a much simpler patch. Hope we're not
>> missing anything, though ...
>>
>
> What about this case: two module variables from two different modules?

Yeah, ok. So we *do* need to distinguish between dummies and other
variables, but maybe we can still get by without additional
'var_name_only' arguments (new patch attached).

Cheers,
Janus

[-- Attachment #2: pr49638_v2.diff --]
[-- Type: text/x-diff, Size: 20648 bytes --]

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 177528)
+++ gcc/fortran/interface.c	(working copy)
@@ -3466,3 +3466,207 @@ gfc_free_formal_arglist (gfc_formal_arglist *p)
       free (p);
     }
 }
+
+
+/* Check that it is ok for the typebound procedure 'proc' to override the
+   procedure 'old' (F08:4.5.7.3).  */
+
+gfc_try
+gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
+{
+  locus where;
+  const gfc_symbol* proc_target;
+  const gfc_symbol* old_target;
+  unsigned proc_pass_arg, old_pass_arg, argpos;
+  gfc_formal_arglist* proc_formal;
+  gfc_formal_arglist* old_formal;
+
+  /* This procedure should only be called for non-GENERIC proc.  */
+  gcc_assert (!proc->n.tb->is_generic);
+
+  /* If the overwritten procedure is GENERIC, this is an error.  */
+  if (old->n.tb->is_generic)
+    {
+      gfc_error ("Can't overwrite GENERIC '%s' at %L",
+		 old->name, &proc->n.tb->where);
+      return FAILURE;
+    }
+
+  where = proc->n.tb->where;
+  proc_target = proc->n.tb->u.specific->n.sym;
+  old_target = old->n.tb->u.specific->n.sym;
+
+  /* Check that overridden binding is not NON_OVERRIDABLE.  */
+  if (old->n.tb->non_overridable)
+    {
+      gfc_error ("'%s' at %L overrides a procedure binding declared"
+		 " NON_OVERRIDABLE", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* It's an error to override a non-DEFERRED procedure with a DEFERRED one.  */
+  if (!old->n.tb->deferred && proc->n.tb->deferred)
+    {
+      gfc_error ("'%s' at %L must not be DEFERRED as it overrides a"
+		 " non-DEFERRED binding", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is PURE, the overriding must be, too.  */
+  if (old_target->attr.pure && !proc_target->attr.pure)
+    {
+      gfc_error ("'%s' at %L overrides a PURE procedure and must also be PURE",
+		 proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is ELEMENTAL, the overriding must be, too.  If it
+     is not, the overriding must not be either.  */
+  if (old_target->attr.elemental && !proc_target->attr.elemental)
+    {
+      gfc_error ("'%s' at %L overrides an ELEMENTAL procedure and must also be"
+		 " ELEMENTAL", proc->name, &where);
+      return FAILURE;
+    }
+  if (!old_target->attr.elemental && proc_target->attr.elemental)
+    {
+      gfc_error ("'%s' at %L overrides a non-ELEMENTAL procedure and must not"
+		 " be ELEMENTAL, either", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is a SUBROUTINE, the overriding must also be a
+     SUBROUTINE.  */
+  if (old_target->attr.subroutine && !proc_target->attr.subroutine)
+    {
+      gfc_error ("'%s' at %L overrides a SUBROUTINE and must also be a"
+		 " SUBROUTINE", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is a FUNCTION, the overriding must also be a
+     FUNCTION and have the same characteristics.  */
+  if (old_target->attr.function)
+    {
+      if (!proc_target->attr.function)
+	{
+	  gfc_error ("'%s' at %L overrides a FUNCTION and must also be a"
+		     " FUNCTION", proc->name, &where);
+	  return FAILURE;
+	}
+
+      /* FIXME:  Do more comprehensive checking (including, for instance,
+	 the array shape).  */
+      gcc_assert (proc_target->result && old_target->result);
+      if (!compare_type_rank (proc_target->result, old_target->result))
+	{
+	  gfc_error ("'%s' at %L and the overridden FUNCTION should have"
+		     " 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
+	  && gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
+				   old_target->result->ts.u.cl->length) != 0)
+	{
+	  gfc_error ("Character length mismatch between '%s' at '%L' "
+		     "and overridden FUNCTION", proc->name, &where);
+	  return FAILURE;
+	}
+    }
+
+  /* If the overridden binding is PUBLIC, the overriding one must not be
+     PRIVATE.  */
+  if (old->n.tb->access == ACCESS_PUBLIC
+      && proc->n.tb->access == ACCESS_PRIVATE)
+    {
+      gfc_error ("'%s' at %L overrides a PUBLIC procedure and must not be"
+		 " PRIVATE", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* Compare the formal argument lists of both procedures.  This is also abused
+     to find the position of the passed-object dummy arguments of both
+     bindings as at least the overridden one might not yet be resolved and we
+     need those positions in the check below.  */
+  proc_pass_arg = old_pass_arg = 0;
+  if (!proc->n.tb->nopass && !proc->n.tb->pass_arg)
+    proc_pass_arg = 1;
+  if (!old->n.tb->nopass && !old->n.tb->pass_arg)
+    old_pass_arg = 1;
+  argpos = 1;
+  for (proc_formal = proc_target->formal, old_formal = old_target->formal;
+       proc_formal && old_formal;
+       proc_formal = proc_formal->next, old_formal = old_formal->next)
+    {
+      if (proc->n.tb->pass_arg
+	  && !strcmp (proc->n.tb->pass_arg, proc_formal->sym->name))
+	proc_pass_arg = argpos;
+      if (old->n.tb->pass_arg
+	  && !strcmp (old->n.tb->pass_arg, old_formal->sym->name))
+	old_pass_arg = argpos;
+
+      /* Check that the names correspond.  */
+      if (strcmp (proc_formal->sym->name, old_formal->sym->name))
+	{
+	  gfc_error ("Dummy argument '%s' of '%s' at %L should be named '%s' as"
+		     " to match the corresponding argument of the overridden"
+		     " procedure", proc_formal->sym->name, proc->name, &where,
+		     old_formal->sym->name);
+	  return FAILURE;
+	}
+
+      /* Check that the types correspond if neither is the passed-object
+	 argument.  */
+      /* FIXME:  Do more comprehensive testing here.  */
+      if (proc_pass_arg != argpos && old_pass_arg != argpos
+	  && !gfc_compare_types (&proc_formal->sym->ts, &old_formal->sym->ts))
+	{
+	  gfc_error ("Types mismatch for dummy argument '%s' of '%s' %L "
+		     "in respect to the overridden procedure",
+		     proc_formal->sym->name, proc->name, &where);
+	  return FAILURE;
+	}
+
+      ++argpos;
+    }
+  if (proc_formal || old_formal)
+    {
+      gfc_error ("'%s' at %L must have the same number of formal arguments as"
+		 " the overridden procedure", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is NOPASS, the overriding one must also be
+     NOPASS.  */
+  if (old->n.tb->nopass && !proc->n.tb->nopass)
+    {
+      gfc_error ("'%s' at %L overrides a NOPASS binding and must also be"
+		 " NOPASS", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is PASS(x), the overriding one must also be
+     PASS and the passed-object dummy arguments must correspond.  */
+  if (!old->n.tb->nopass)
+    {
+      if (proc->n.tb->nopass)
+	{
+	  gfc_error ("'%s' at %L overrides a binding with PASS and must also be"
+		     " PASS", proc->name, &where);
+	  return FAILURE;
+	}
+
+      if (proc_pass_arg != old_pass_arg)
+	{
+	  gfc_error ("Passed-object dummy argument of '%s' at %L must be at"
+		     " the same position as the passed-object dummy argument of"
+		     " the overridden procedure", proc->name, &where);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 177528)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2840,6 +2840,7 @@ bool gfc_arglist_matches_symbol (gfc_actual_arglis
 bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
 int gfc_has_vector_subscript (gfc_expr*);
 gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op);
+gfc_try gfc_check_typebound_override (gfc_symtree*, gfc_symtree*);
 
 /* io.c */
 extern gfc_st_label format_asterisk;
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 177528)
+++ gcc/fortran/resolve.c	(working copy)
@@ -10672,200 +10672,6 @@ error:
 }
 
 
-/* Check that it is ok for the typebound procedure proc to override the
-   procedure old.  */
-
-static gfc_try
-check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
-{
-  locus where;
-  const gfc_symbol* proc_target;
-  const gfc_symbol* old_target;
-  unsigned proc_pass_arg, old_pass_arg, argpos;
-  gfc_formal_arglist* proc_formal;
-  gfc_formal_arglist* old_formal;
-
-  /* This procedure should only be called for non-GENERIC proc.  */
-  gcc_assert (!proc->n.tb->is_generic);
-
-  /* If the overwritten procedure is GENERIC, this is an error.  */
-  if (old->n.tb->is_generic)
-    {
-      gfc_error ("Can't overwrite GENERIC '%s' at %L",
-		 old->name, &proc->n.tb->where);
-      return FAILURE;
-    }
-
-  where = proc->n.tb->where;
-  proc_target = proc->n.tb->u.specific->n.sym;
-  old_target = old->n.tb->u.specific->n.sym;
-
-  /* Check that overridden binding is not NON_OVERRIDABLE.  */
-  if (old->n.tb->non_overridable)
-    {
-      gfc_error ("'%s' at %L overrides a procedure binding declared"
-		 " NON_OVERRIDABLE", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* It's an error to override a non-DEFERRED procedure with a DEFERRED one.  */
-  if (!old->n.tb->deferred && proc->n.tb->deferred)
-    {
-      gfc_error ("'%s' at %L must not be DEFERRED as it overrides a"
-		 " non-DEFERRED binding", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is PURE, the overriding must be, too.  */
-  if (old_target->attr.pure && !proc_target->attr.pure)
-    {
-      gfc_error ("'%s' at %L overrides a PURE procedure and must also be PURE",
-		 proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is ELEMENTAL, the overriding must be, too.  If it
-     is not, the overriding must not be either.  */
-  if (old_target->attr.elemental && !proc_target->attr.elemental)
-    {
-      gfc_error ("'%s' at %L overrides an ELEMENTAL procedure and must also be"
-		 " ELEMENTAL", proc->name, &where);
-      return FAILURE;
-    }
-  if (!old_target->attr.elemental && proc_target->attr.elemental)
-    {
-      gfc_error ("'%s' at %L overrides a non-ELEMENTAL procedure and must not"
-		 " be ELEMENTAL, either", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is a SUBROUTINE, the overriding must also be a
-     SUBROUTINE.  */
-  if (old_target->attr.subroutine && !proc_target->attr.subroutine)
-    {
-      gfc_error ("'%s' at %L overrides a SUBROUTINE and must also be a"
-		 " SUBROUTINE", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is a FUNCTION, the overriding must also be a
-     FUNCTION and have the same characteristics.  */
-  if (old_target->attr.function)
-    {
-      if (!proc_target->attr.function)
-	{
-	  gfc_error ("'%s' at %L overrides a FUNCTION and must also be a"
-		     " FUNCTION", proc->name, &where);
-	  return FAILURE;
-	}
-
-      /* FIXME:  Do more comprehensive checking (including, for instance, the
-	 rank and array-shape).  */
-      gcc_assert (proc_target->result && old_target->result);
-      if (!gfc_compare_types (&proc_target->result->ts,
-			      &old_target->result->ts))
-	{
-	  gfc_error ("'%s' at %L and the overridden FUNCTION should have"
-		     " matching result types", proc->name, &where);
-	  return FAILURE;
-	}
-    }
-
-  /* If the overridden binding is PUBLIC, the overriding one must not be
-     PRIVATE.  */
-  if (old->n.tb->access == ACCESS_PUBLIC
-      && proc->n.tb->access == ACCESS_PRIVATE)
-    {
-      gfc_error ("'%s' at %L overrides a PUBLIC procedure and must not be"
-		 " PRIVATE", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* Compare the formal argument lists of both procedures.  This is also abused
-     to find the position of the passed-object dummy arguments of both
-     bindings as at least the overridden one might not yet be resolved and we
-     need those positions in the check below.  */
-  proc_pass_arg = old_pass_arg = 0;
-  if (!proc->n.tb->nopass && !proc->n.tb->pass_arg)
-    proc_pass_arg = 1;
-  if (!old->n.tb->nopass && !old->n.tb->pass_arg)
-    old_pass_arg = 1;
-  argpos = 1;
-  for (proc_formal = proc_target->formal, old_formal = old_target->formal;
-       proc_formal && old_formal;
-       proc_formal = proc_formal->next, old_formal = old_formal->next)
-    {
-      if (proc->n.tb->pass_arg
-	  && !strcmp (proc->n.tb->pass_arg, proc_formal->sym->name))
-	proc_pass_arg = argpos;
-      if (old->n.tb->pass_arg
-	  && !strcmp (old->n.tb->pass_arg, old_formal->sym->name))
-	old_pass_arg = argpos;
-
-      /* Check that the names correspond.  */
-      if (strcmp (proc_formal->sym->name, old_formal->sym->name))
-	{
-	  gfc_error ("Dummy argument '%s' of '%s' at %L should be named '%s' as"
-		     " to match the corresponding argument of the overridden"
-		     " procedure", proc_formal->sym->name, proc->name, &where,
-		     old_formal->sym->name);
-	  return FAILURE;
-	}
-
-      /* Check that the types correspond if neither is the passed-object
-	 argument.  */
-      /* FIXME:  Do more comprehensive testing here.  */
-      if (proc_pass_arg != argpos && old_pass_arg != argpos
-	  && !gfc_compare_types (&proc_formal->sym->ts, &old_formal->sym->ts))
-	{
-	  gfc_error ("Types mismatch for dummy argument '%s' of '%s' %L "
-		     "in respect to the overridden procedure",
-		     proc_formal->sym->name, proc->name, &where);
-	  return FAILURE;
-	}
-
-      ++argpos;
-    }
-  if (proc_formal || old_formal)
-    {
-      gfc_error ("'%s' at %L must have the same number of formal arguments as"
-		 " the overridden procedure", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is NOPASS, the overriding one must also be
-     NOPASS.  */
-  if (old->n.tb->nopass && !proc->n.tb->nopass)
-    {
-      gfc_error ("'%s' at %L overrides a NOPASS binding and must also be"
-		 " NOPASS", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is PASS(x), the overriding one must also be
-     PASS and the passed-object dummy arguments must correspond.  */
-  if (!old->n.tb->nopass)
-    {
-      if (proc->n.tb->nopass)
-	{
-	  gfc_error ("'%s' at %L overrides a binding with PASS and must also be"
-		     " PASS", proc->name, &where);
-	  return FAILURE;
-	}
-
-      if (proc_pass_arg != old_pass_arg)
-	{
-	  gfc_error ("Passed-object dummy argument of '%s' at %L must be at"
-		     " the same position as the passed-object dummy argument of"
-		     " the overridden procedure", proc->name, &where);
-	  return FAILURE;
-	}
-    }
-
-  return SUCCESS;
-}
-
-
 /* Check if two GENERIC targets are ambiguous and emit an error is they are.  */
 
 static gfc_try
@@ -11327,11 +11133,14 @@ resolve_typebound_procedure (gfc_symtree* stree)
       overridden = gfc_find_typebound_proc (super_type, NULL,
 					    stree->name, true, NULL);
 
-      if (overridden && overridden->n.tb)
-	stree->n.tb->overridden = overridden->n.tb;
+      if (overridden)
+	{
+	  if (overridden->n.tb)
+	    stree->n.tb->overridden = overridden->n.tb;
 
-      if (overridden && check_typebound_override (stree, overridden) == FAILURE)
-	goto error;
+	  if (gfc_check_typebound_override (stree, overridden) == FAILURE)
+	    goto error;
+	}
     }
 
   /* See if there's a name collision with a component directly in this type.  */
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c	(revision 177528)
+++ gcc/fortran/dependency.c	(working copy)
@@ -118,13 +118,23 @@ identical_array_ref (gfc_array_ref *a1, gfc_array_
 /* Return true for identical variables, checking for references if
    necessary.  Calls identical_array_ref for checking array sections.  */
 
-bool
-gfc_are_identical_variables (gfc_expr *e1, gfc_expr *e2)
+static bool
+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.  */
 
@@ -169,7 +179,7 @@ identical_array_ref (gfc_array_ref *a1, gfc_array_
 	  break;
 
 	default:
-	  gfc_internal_error ("gfc_are_identical_variables: Bad type");
+	  gfc_internal_error ("are_identical_variables: Bad type");
 	}
       r1 = r1->next;
       r2 = r2->next;
@@ -421,7 +431,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
       return 1;
 
     case EXPR_VARIABLE:
-      if (gfc_are_identical_variables (e1, e2))
+      if (are_identical_variables (e1, e2))
 	return 0;
       else
 	return -2;
@@ -438,7 +448,12 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
       if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0
 	  && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0)
 	return 0;
-      /* TODO Handle commutative binary operators here?  */
+      else if (e1->value.op.op == INTRINSIC_TIMES
+	       && gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2) == 0
+	       && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1) == 0)
+	/* Commutativity of multiplication.  */
+	return 0;
+
       return -2;
 
     case EXPR_FUNCTION:
@@ -451,11 +466,11 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 }
 
 
-/* Returns 1 if the two ranges are the same, 0 if they are not, and def
-   if the results are indeterminate.  N is the dimension to compare.  */
+/* Returns 1 if the two ranges are the same and 0 if they are not (or if the
+   results are indeterminate). 'n' is the dimension to compare.  */
 
-int
-gfc_is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n, int def)
+static int
+is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n)
 {
   gfc_expr *e1;
   gfc_expr *e2;
@@ -472,25 +487,19 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
   if (e1 && !e2)
     {
       i = gfc_expr_is_one (e1, -1);
-      if (i == -1)
-	return def;
-      else if (i == 0)
+      if (i == -1 || i == 0)
 	return 0;
     }
   else if (e2 && !e1)
     {
       i = gfc_expr_is_one (e2, -1);
-      if (i == -1)
-	return def;
-      else if (i == 0)
+      if (i == -1 || i == 0)
 	return 0;
     }
   else if (e1 && e2)
     {
       i = gfc_dep_compare_expr (e1, e2);
-      if (i == -2)
-	return def;
-      else if (i != 0)
+      if (i != 0)
 	return 0;
     }
   /* The strides match.  */
@@ -509,12 +518,10 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 
       /* Check we have values for both.  */
       if (!(e1 && e2))
-	return def;
+	return 0;
 
       i = gfc_dep_compare_expr (e1, e2);
-      if (i == -2)
-	return def;
-      else if (i != 0)
+      if (i != 0)
 	return 0;
     }
 
@@ -532,12 +539,10 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 
       /* Check we have values for both.  */
       if (!(e1 && e2))
-	return def;
+	return 0;
 
       i = gfc_dep_compare_expr (e1, e2);
-      if (i == -2)
-	return def;
-      else if (i != 0)
+      if (i != 0)
 	return 0;
     }
 
@@ -1091,7 +1096,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
   int start_comparison;
 
   /* If they are the same range, return without more ado.  */
-  if (gfc_is_same_range (l_ar, r_ar, n, 0))
+  if (is_same_range (l_ar, r_ar, n))
     return GFC_DEP_EQUAL;
 
   l_start = l_ar->start[n];
Index: gcc/fortran/dependency.h
===================================================================
--- gcc/fortran/dependency.h	(revision 177528)
+++ gcc/fortran/dependency.h	(working copy)
@@ -37,11 +37,8 @@ gfc_expr *gfc_get_noncopying_intrinsic_argument (g
 int gfc_check_fncall_dependency (gfc_expr *, sym_intent, gfc_symbol *,
 				 gfc_actual_arglist *, gfc_dep_check);
 int gfc_check_dependency (gfc_expr *, gfc_expr *, bool);
-int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, int);
+/*int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, bool);*/
 int gfc_expr_is_one (gfc_expr *, int);
 
 int gfc_dep_resolver(gfc_ref *, gfc_ref *, gfc_reverse *);
 int gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
-
-bool gfc_are_identical_variables (gfc_expr *, gfc_expr *);
-

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 18:37                   ` Janus Weil
@ 2011-08-06 20:32                     ` Thomas Koenig
  2011-08-06 21:11                       ` Janus Weil
  0 siblings, 1 reply; 43+ messages in thread
From: Thomas Koenig @ 2011-08-06 20:32 UTC (permalink / raw)
  To: Janus Weil; +Cc: Mikael Morin, fortran, gcc-patches

Hi Janus,

> +      /* Check string length.  */
> +      if (proc_target->result->ts.type == BT_CHARACTER
> +	&&  proc_target->result->ts.u.cl&&  old_target->result->ts.u.cl
> +	&&  gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
> +				   old_target->result->ts.u.cl->length) != 0)

This remains incorrect.

Please change that to a warning (at least) if gfc_dep_compare_expr 
returns -2.

Regards

	Thomas

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 20:32                     ` Thomas Koenig
@ 2011-08-06 21:11                       ` Janus Weil
  2011-08-06 21:40                         ` Thomas Koenig
  0 siblings, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-06 21:11 UTC (permalink / raw)
  To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches

Hi Thomas,

>> +      /* Check string length.  */
>> +      if (proc_target->result->ts.type == BT_CHARACTER
>> +       &&  proc_target->result->ts.u.cl&&  old_target->result->ts.u.cl
>> +       &&  gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
>> +                                  old_target->result->ts.u.cl->length) !=
>> 0)
>
> This remains incorrect.

well, I'm not so sure. If we assume a 'strict' interpretation of
Mikael's standard quotes, then it would be ok.

> Please change that to a warning (at least) if gfc_dep_compare_expr returns
> -2.

I don't think this is a good idea: gfc_dep_compare_expr also tries to
determine whether one expr is larger or smaller than the other.
Therefore the return value "-2" can have two meanings:

1) We don't know if the expressions are equal.
2) We know that they are unequal, but we don't know which one is larger.

For the overriding check, we don't care about which expr is larger, we
want to know whether they are the same or not. So, in many cases we
will just get a warning, although we definitely know that the expr's
are different.

Example: Differing expr_type, e.g. one procedure has len=3, the other
has len=x. It's obvious they are different, but gfc_dep_compare_expr
will still return "-2" (because we can not tell which one is larger).

I would tend to leave the check like it is (i.e. rejecting everything
!=0), but if you insist, one could extend the output values of
gfc_dep_compare_expr, e.g. like this:
-3 = we know nothing (neither if they could be equal, nor which one is larger)
-2 = we know they are different, but not which one is larger

However, one may then have to modify the diagnostics on these return
values in quite a few places(?).

Note: The last version of my patch also regtests fine.

Cheers,
Janus

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 21:11                       ` Janus Weil
@ 2011-08-06 21:40                         ` Thomas Koenig
  2011-08-06 21:59                           ` Janus Weil
  0 siblings, 1 reply; 43+ messages in thread
From: Thomas Koenig @ 2011-08-06 21:40 UTC (permalink / raw)
  To: Janus Weil; +Cc: Mikael Morin, fortran, gcc-patches

Am 06.08.2011 21:26, schrieb Janus Weil:
> Hi Thomas,
>
>>> +      /* Check string length.  */
>>> +      if (proc_target->result->ts.type == BT_CHARACTER
>>> +&&    proc_target->result->ts.u.cl&&    old_target->result->ts.u.cl
>>> +&&    gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
>>> +                                  old_target->result->ts.u.cl->length) !=
>>> 0)
>>
>> This remains incorrect.
>
> well, I'm not so sure. If we assume a 'strict' interpretation of
> Mikael's standard quotes, then it would be ok.

I think that interpretation is wrong too, based on the leeway that
the standard gives in interpreting expressions.  a + b + c and
c + b + a are mathematically equivalent, and, right now, we cannot
prove them to be so.  (Yes, I would dearly like to do that, but
that is really hard based on the current gfc_expr format.  Instead
of parsing a + b + c as (+ (+ a b) c) like we do now, using (+ a b c)
which would make simplification much easier.  But the question is how
much we would gain from this vs. the effort :-).

Even hardline interpretation were correct, we are not even required to
diagnose this, because this is not a constraint.  The burden is on the
programmer, not the compiler writer.

I think it is most important to not reject correct programs.

>
>> Please change that to a warning (at least) if gfc_dep_compare_expr returns
>> -2.
>
> I don't think this is a good idea: gfc_dep_compare_expr also tries to
> determine whether one expr is larger or smaller than the other.
> Therefore the return value "-2" can have two meanings:
>
> 1) We don't know if the expressions are equal.
> 2) We know that they are unequal, but we don't know which one is larger.

Right now, we have the following cases (assuming the expressions to
be compared are a and b):

1 : We can prove that for all possible variable values, a > b
0 : We can prove that for all possible variable values, a = b
-1 : We can prove that all possible variable values, a < b
-2 : We cannot prove any of the above.

> For the overriding check, we don't care about which expr is larger, we
> want to know whether they are the same or not. So, in many cases we
> will just get a warning, although we definitely know that the expr's
> are different.
>
> Example: Differing expr_type, e.g. one procedure has len=3, the other
> has len=x. It's obvious they are different, but gfc_dep_compare_expr
> will still return "-2" (because we can not tell which one is larger).

In the context of what gfc_dep_compare_expr usually does, these 
expressions may be equal, because x may be 3.

> I would tend to leave the check like it is (i.e. rejecting everything
> !=0), but if you insist, one could extend the output values of
> gfc_dep_compare_expr, e.g. like this:
> -3 = we know nothing (neither if they could be equal, nor which one is larger)
> -2 = we know they are different, but not which one is larger

What you mean is that we should be able to prove that there
exists an x so that a != b.

If you can extend gfc_dep_compare_expr to prove this, great.  However,
for this, you must also handle a + b + c vs. c + b + a, i.e.
(+ (+ a b ) c) vs. (+ (+ c b) a).

> However, one may then have to modify the diagnostics on these return
> values in quite a few places(?).

I suspect that extending gfc_dep_compare_expr will be much more 
difficult than changing its calling sequence :-)

Regards

	Thomas

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 21:40                         ` Thomas Koenig
@ 2011-08-06 21:59                           ` Janus Weil
  2011-08-06 23:14                             ` Thomas Koenig
  0 siblings, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-06 21:59 UTC (permalink / raw)
  To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches

>> For the overriding check, we don't care about which expr is larger, we
>> want to know whether they are the same or not. So, in many cases we
>> will just get a warning, although we definitely know that the expr's
>> are different.
>>
>> Example: Differing expr_type, e.g. one procedure has len=3, the other
>> has len=x. It's obvious they are different, but gfc_dep_compare_expr
>> will still return "-2" (because we can not tell which one is larger).
>
> In the context of what gfc_dep_compare_expr usually does, these expressions
> may be equal, because x may be 3.

I guess that is just one way in which the things it usually does
differ a bit from what I'm trying to do with it. Anyway, I think the
tasks are reasonably similar to justify reusing gfc_dep_compare_expr
instead of writing a new set of procedures, which would have to be of
similar complexity.

>> I would tend to leave the check like it is (i.e. rejecting everything
>> !=0), but if you insist, one could extend the output values of
>> gfc_dep_compare_expr, e.g. like this:
>> -3 = we know nothing (neither if they could be equal, nor which one is
>> larger)
>> -2 = we know they are different, but not which one is larger
>
> What you mean is that we should be able to prove that there
> exists an x so that a != b.

Yes, if you want to express it in such a way.

I'm know that this does not exactly fit in any of your categories.
However, I still think that throwing an error for every case where we
can not prove that the expressions are equal is a good approximation
for the purpose, and everything beyond that is mostly academic.

Firstly, string lengths of overridden type-bound procedures will
probably never be extremely complicated expressions. Remember: The
original bug report here was really just about *constant* string
lengths, which is the most trivial and probably most frequent case.
Second, it is easy for the programmer to lay out the expressions in
analogous ways when overriding, so that gfc_dep_compare_expr is indeed
able to prove they are equal. And third, in case there will really be
any real-world problems with this, we can just wait for that bug
report to roll in, and take care of the problem later (by refining
gfc_dep_compare_expr's ability to prove two expressions are equal,
e.g. by implementing more math transformations or similar things).

Cheers,
Janus

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 21:59                           ` Janus Weil
@ 2011-08-06 23:14                             ` Thomas Koenig
  2011-08-07  2:11                               ` Janus Weil
  0 siblings, 1 reply; 43+ messages in thread
From: Thomas Koenig @ 2011-08-06 23:14 UTC (permalink / raw)
  To: Janus Weil; +Cc: Mikael Morin, fortran, gcc-patches

Am 06.08.2011 23:10, schrieb Janus Weil:
> I'm know that this does not exactly fit in any of your categories.
> However, I still think that throwing an error for every case where we
> can not prove that the expressions are equal is a good approximation
> for the purpose, and everything beyond that is mostly academic.

And this is where I disagree, I think we should not raise an error
if we cannot prove that what the user did was wrong.  This would
be a rejects-valid bug.

As for the a+b+c vs. c+b+a issue, I have asked on c.l.f.

Regards

	Thomas

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 23:14                             ` Thomas Koenig
@ 2011-08-07  2:11                               ` Janus Weil
  2011-08-07  3:39                                 ` Mikael Morin
  2011-08-07 10:57                                 ` Thomas Koenig
  0 siblings, 2 replies; 43+ messages in thread
From: Janus Weil @ 2011-08-07  2:11 UTC (permalink / raw)
  To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 1877 bytes --]

2011/8/6 Thomas Koenig <tkoenig@netcologne.de>:
> Am 06.08.2011 23:10, schrieb Janus Weil:
>>
>> I'm know that this does not exactly fit in any of your categories.
>> However, I still think that throwing an error for every case where we
>> can not prove that the expressions are equal is a good approximation
>> for the purpose, and everything beyond that is mostly academic.
>
> And this is where I disagree, I think we should not raise an error
> if we cannot prove that what the user did was wrong.  This would
> be a rejects-valid bug.


Well, ok. After this amount of discussion, how about we start with the
easy things: Here is a preparational patch (basically a subset of the
previous one), which does not do any real changes yet, only some
preparation and cleanup:
* It moves check_typebound_override to interface.c and prefixes it
with gfc_ (I don't like moving and modifying it at the same time).
* It add the commutativity of multiplication in gfc_dep_compare_expr.
* It does some minor cleanup in dependency.c (making two routines
static and removing an unused argument).

Ok for trunk?

Cheers,
Janus


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

	PR fortran/49638
	* dependency.h (gfc_is_same_range,gfc_are_identical_variables): Remove
	two prototypes.
	* dependency.c (gfc_are_identical_variables): Made static and renamed.
	(gfc_dep_compare_expr): Renamed 'gfc_are_identical_variables', handle
	commutativity of multiplication.
	(gfc_is_same_range): Made static and renamed, removed argument 'def'.
	(check_section_vs_section): Renamed 'gfc_is_same_range'.
	* gfortran.h (gfc_check_typebound_override): New prototype.
	* interface.c (gfc_check_typebound_override): Moved here from ...
	* resolv.c (check_typebound_override): ... here (and renamed).
	(resolve_typebound_procedure): Renamed 'check_typebound_override'.

[-- Attachment #2: pr49638_prep.diff --]
[-- Type: text/x-diff, Size: 19720 bytes --]

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 177528)
+++ gcc/fortran/interface.c	(working copy)
@@ -3466,3 +3466,197 @@ gfc_free_formal_arglist (gfc_formal_arglist *p)
       free (p);
     }
 }
+
+
+/* Check that it is ok for the typebound procedure proc to override the
+   procedure old.  */
+
+gfc_try
+gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
+{
+  locus where;
+  const gfc_symbol* proc_target;
+  const gfc_symbol* old_target;
+  unsigned proc_pass_arg, old_pass_arg, argpos;
+  gfc_formal_arglist* proc_formal;
+  gfc_formal_arglist* old_formal;
+
+  /* This procedure should only be called for non-GENERIC proc.  */
+  gcc_assert (!proc->n.tb->is_generic);
+
+  /* If the overwritten procedure is GENERIC, this is an error.  */
+  if (old->n.tb->is_generic)
+    {
+      gfc_error ("Can't overwrite GENERIC '%s' at %L",
+		 old->name, &proc->n.tb->where);
+      return FAILURE;
+    }
+
+  where = proc->n.tb->where;
+  proc_target = proc->n.tb->u.specific->n.sym;
+  old_target = old->n.tb->u.specific->n.sym;
+
+  /* Check that overridden binding is not NON_OVERRIDABLE.  */
+  if (old->n.tb->non_overridable)
+    {
+      gfc_error ("'%s' at %L overrides a procedure binding declared"
+		 " NON_OVERRIDABLE", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* It's an error to override a non-DEFERRED procedure with a DEFERRED one.  */
+  if (!old->n.tb->deferred && proc->n.tb->deferred)
+    {
+      gfc_error ("'%s' at %L must not be DEFERRED as it overrides a"
+		 " non-DEFERRED binding", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is PURE, the overriding must be, too.  */
+  if (old_target->attr.pure && !proc_target->attr.pure)
+    {
+      gfc_error ("'%s' at %L overrides a PURE procedure and must also be PURE",
+		 proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is ELEMENTAL, the overriding must be, too.  If it
+     is not, the overriding must not be either.  */
+  if (old_target->attr.elemental && !proc_target->attr.elemental)
+    {
+      gfc_error ("'%s' at %L overrides an ELEMENTAL procedure and must also be"
+		 " ELEMENTAL", proc->name, &where);
+      return FAILURE;
+    }
+  if (!old_target->attr.elemental && proc_target->attr.elemental)
+    {
+      gfc_error ("'%s' at %L overrides a non-ELEMENTAL procedure and must not"
+		 " be ELEMENTAL, either", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is a SUBROUTINE, the overriding must also be a
+     SUBROUTINE.  */
+  if (old_target->attr.subroutine && !proc_target->attr.subroutine)
+    {
+      gfc_error ("'%s' at %L overrides a SUBROUTINE and must also be a"
+		 " SUBROUTINE", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is a FUNCTION, the overriding must also be a
+     FUNCTION and have the same characteristics.  */
+  if (old_target->attr.function)
+    {
+      if (!proc_target->attr.function)
+	{
+	  gfc_error ("'%s' at %L overrides a FUNCTION and must also be a"
+		     " FUNCTION", proc->name, &where);
+	  return FAILURE;
+	}
+
+      /* FIXME:  Do more comprehensive checking (including, for instance, the
+	 rank and array-shape).  */
+      gcc_assert (proc_target->result && old_target->result);
+      if (!gfc_compare_types (&proc_target->result->ts,
+			      &old_target->result->ts))
+	{
+	  gfc_error ("'%s' at %L and the overridden FUNCTION should have"
+		     " matching result types", proc->name, &where);
+	  return FAILURE;
+	}
+    }
+
+  /* If the overridden binding is PUBLIC, the overriding one must not be
+     PRIVATE.  */
+  if (old->n.tb->access == ACCESS_PUBLIC
+      && proc->n.tb->access == ACCESS_PRIVATE)
+    {
+      gfc_error ("'%s' at %L overrides a PUBLIC procedure and must not be"
+		 " PRIVATE", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* Compare the formal argument lists of both procedures.  This is also abused
+     to find the position of the passed-object dummy arguments of both
+     bindings as at least the overridden one might not yet be resolved and we
+     need those positions in the check below.  */
+  proc_pass_arg = old_pass_arg = 0;
+  if (!proc->n.tb->nopass && !proc->n.tb->pass_arg)
+    proc_pass_arg = 1;
+  if (!old->n.tb->nopass && !old->n.tb->pass_arg)
+    old_pass_arg = 1;
+  argpos = 1;
+  for (proc_formal = proc_target->formal, old_formal = old_target->formal;
+       proc_formal && old_formal;
+       proc_formal = proc_formal->next, old_formal = old_formal->next)
+    {
+      if (proc->n.tb->pass_arg
+	  && !strcmp (proc->n.tb->pass_arg, proc_formal->sym->name))
+	proc_pass_arg = argpos;
+      if (old->n.tb->pass_arg
+	  && !strcmp (old->n.tb->pass_arg, old_formal->sym->name))
+	old_pass_arg = argpos;
+
+      /* Check that the names correspond.  */
+      if (strcmp (proc_formal->sym->name, old_formal->sym->name))
+	{
+	  gfc_error ("Dummy argument '%s' of '%s' at %L should be named '%s' as"
+		     " to match the corresponding argument of the overridden"
+		     " procedure", proc_formal->sym->name, proc->name, &where,
+		     old_formal->sym->name);
+	  return FAILURE;
+	}
+
+      /* Check that the types correspond if neither is the passed-object
+	 argument.  */
+      /* FIXME:  Do more comprehensive testing here.  */
+      if (proc_pass_arg != argpos && old_pass_arg != argpos
+	  && !gfc_compare_types (&proc_formal->sym->ts, &old_formal->sym->ts))
+	{
+	  gfc_error ("Types mismatch for dummy argument '%s' of '%s' %L "
+		     "in respect to the overridden procedure",
+		     proc_formal->sym->name, proc->name, &where);
+	  return FAILURE;
+	}
+
+      ++argpos;
+    }
+  if (proc_formal || old_formal)
+    {
+      gfc_error ("'%s' at %L must have the same number of formal arguments as"
+		 " the overridden procedure", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is NOPASS, the overriding one must also be
+     NOPASS.  */
+  if (old->n.tb->nopass && !proc->n.tb->nopass)
+    {
+      gfc_error ("'%s' at %L overrides a NOPASS binding and must also be"
+		 " NOPASS", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is PASS(x), the overriding one must also be
+     PASS and the passed-object dummy arguments must correspond.  */
+  if (!old->n.tb->nopass)
+    {
+      if (proc->n.tb->nopass)
+	{
+	  gfc_error ("'%s' at %L overrides a binding with PASS and must also be"
+		     " PASS", proc->name, &where);
+	  return FAILURE;
+	}
+
+      if (proc_pass_arg != old_pass_arg)
+	{
+	  gfc_error ("Passed-object dummy argument of '%s' at %L must be at"
+		     " the same position as the passed-object dummy argument of"
+		     " the overridden procedure", proc->name, &where);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 177528)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2840,6 +2840,7 @@ bool gfc_arglist_matches_symbol (gfc_actual_arglis
 bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
 int gfc_has_vector_subscript (gfc_expr*);
 gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op);
+gfc_try gfc_check_typebound_override (gfc_symtree*, gfc_symtree*);
 
 /* io.c */
 extern gfc_st_label format_asterisk;
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 177528)
+++ gcc/fortran/resolve.c	(working copy)
@@ -10672,200 +10672,6 @@ error:
 }
 
 
-/* Check that it is ok for the typebound procedure proc to override the
-   procedure old.  */
-
-static gfc_try
-check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
-{
-  locus where;
-  const gfc_symbol* proc_target;
-  const gfc_symbol* old_target;
-  unsigned proc_pass_arg, old_pass_arg, argpos;
-  gfc_formal_arglist* proc_formal;
-  gfc_formal_arglist* old_formal;
-
-  /* This procedure should only be called for non-GENERIC proc.  */
-  gcc_assert (!proc->n.tb->is_generic);
-
-  /* If the overwritten procedure is GENERIC, this is an error.  */
-  if (old->n.tb->is_generic)
-    {
-      gfc_error ("Can't overwrite GENERIC '%s' at %L",
-		 old->name, &proc->n.tb->where);
-      return FAILURE;
-    }
-
-  where = proc->n.tb->where;
-  proc_target = proc->n.tb->u.specific->n.sym;
-  old_target = old->n.tb->u.specific->n.sym;
-
-  /* Check that overridden binding is not NON_OVERRIDABLE.  */
-  if (old->n.tb->non_overridable)
-    {
-      gfc_error ("'%s' at %L overrides a procedure binding declared"
-		 " NON_OVERRIDABLE", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* It's an error to override a non-DEFERRED procedure with a DEFERRED one.  */
-  if (!old->n.tb->deferred && proc->n.tb->deferred)
-    {
-      gfc_error ("'%s' at %L must not be DEFERRED as it overrides a"
-		 " non-DEFERRED binding", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is PURE, the overriding must be, too.  */
-  if (old_target->attr.pure && !proc_target->attr.pure)
-    {
-      gfc_error ("'%s' at %L overrides a PURE procedure and must also be PURE",
-		 proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is ELEMENTAL, the overriding must be, too.  If it
-     is not, the overriding must not be either.  */
-  if (old_target->attr.elemental && !proc_target->attr.elemental)
-    {
-      gfc_error ("'%s' at %L overrides an ELEMENTAL procedure and must also be"
-		 " ELEMENTAL", proc->name, &where);
-      return FAILURE;
-    }
-  if (!old_target->attr.elemental && proc_target->attr.elemental)
-    {
-      gfc_error ("'%s' at %L overrides a non-ELEMENTAL procedure and must not"
-		 " be ELEMENTAL, either", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is a SUBROUTINE, the overriding must also be a
-     SUBROUTINE.  */
-  if (old_target->attr.subroutine && !proc_target->attr.subroutine)
-    {
-      gfc_error ("'%s' at %L overrides a SUBROUTINE and must also be a"
-		 " SUBROUTINE", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is a FUNCTION, the overriding must also be a
-     FUNCTION and have the same characteristics.  */
-  if (old_target->attr.function)
-    {
-      if (!proc_target->attr.function)
-	{
-	  gfc_error ("'%s' at %L overrides a FUNCTION and must also be a"
-		     " FUNCTION", proc->name, &where);
-	  return FAILURE;
-	}
-
-      /* FIXME:  Do more comprehensive checking (including, for instance, the
-	 rank and array-shape).  */
-      gcc_assert (proc_target->result && old_target->result);
-      if (!gfc_compare_types (&proc_target->result->ts,
-			      &old_target->result->ts))
-	{
-	  gfc_error ("'%s' at %L and the overridden FUNCTION should have"
-		     " matching result types", proc->name, &where);
-	  return FAILURE;
-	}
-    }
-
-  /* If the overridden binding is PUBLIC, the overriding one must not be
-     PRIVATE.  */
-  if (old->n.tb->access == ACCESS_PUBLIC
-      && proc->n.tb->access == ACCESS_PRIVATE)
-    {
-      gfc_error ("'%s' at %L overrides a PUBLIC procedure and must not be"
-		 " PRIVATE", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* Compare the formal argument lists of both procedures.  This is also abused
-     to find the position of the passed-object dummy arguments of both
-     bindings as at least the overridden one might not yet be resolved and we
-     need those positions in the check below.  */
-  proc_pass_arg = old_pass_arg = 0;
-  if (!proc->n.tb->nopass && !proc->n.tb->pass_arg)
-    proc_pass_arg = 1;
-  if (!old->n.tb->nopass && !old->n.tb->pass_arg)
-    old_pass_arg = 1;
-  argpos = 1;
-  for (proc_formal = proc_target->formal, old_formal = old_target->formal;
-       proc_formal && old_formal;
-       proc_formal = proc_formal->next, old_formal = old_formal->next)
-    {
-      if (proc->n.tb->pass_arg
-	  && !strcmp (proc->n.tb->pass_arg, proc_formal->sym->name))
-	proc_pass_arg = argpos;
-      if (old->n.tb->pass_arg
-	  && !strcmp (old->n.tb->pass_arg, old_formal->sym->name))
-	old_pass_arg = argpos;
-
-      /* Check that the names correspond.  */
-      if (strcmp (proc_formal->sym->name, old_formal->sym->name))
-	{
-	  gfc_error ("Dummy argument '%s' of '%s' at %L should be named '%s' as"
-		     " to match the corresponding argument of the overridden"
-		     " procedure", proc_formal->sym->name, proc->name, &where,
-		     old_formal->sym->name);
-	  return FAILURE;
-	}
-
-      /* Check that the types correspond if neither is the passed-object
-	 argument.  */
-      /* FIXME:  Do more comprehensive testing here.  */
-      if (proc_pass_arg != argpos && old_pass_arg != argpos
-	  && !gfc_compare_types (&proc_formal->sym->ts, &old_formal->sym->ts))
-	{
-	  gfc_error ("Types mismatch for dummy argument '%s' of '%s' %L "
-		     "in respect to the overridden procedure",
-		     proc_formal->sym->name, proc->name, &where);
-	  return FAILURE;
-	}
-
-      ++argpos;
-    }
-  if (proc_formal || old_formal)
-    {
-      gfc_error ("'%s' at %L must have the same number of formal arguments as"
-		 " the overridden procedure", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is NOPASS, the overriding one must also be
-     NOPASS.  */
-  if (old->n.tb->nopass && !proc->n.tb->nopass)
-    {
-      gfc_error ("'%s' at %L overrides a NOPASS binding and must also be"
-		 " NOPASS", proc->name, &where);
-      return FAILURE;
-    }
-
-  /* If the overridden binding is PASS(x), the overriding one must also be
-     PASS and the passed-object dummy arguments must correspond.  */
-  if (!old->n.tb->nopass)
-    {
-      if (proc->n.tb->nopass)
-	{
-	  gfc_error ("'%s' at %L overrides a binding with PASS and must also be"
-		     " PASS", proc->name, &where);
-	  return FAILURE;
-	}
-
-      if (proc_pass_arg != old_pass_arg)
-	{
-	  gfc_error ("Passed-object dummy argument of '%s' at %L must be at"
-		     " the same position as the passed-object dummy argument of"
-		     " the overridden procedure", proc->name, &where);
-	  return FAILURE;
-	}
-    }
-
-  return SUCCESS;
-}
-
-
 /* Check if two GENERIC targets are ambiguous and emit an error is they are.  */
 
 static gfc_try
@@ -11327,11 +11133,14 @@ resolve_typebound_procedure (gfc_symtree* stree)
       overridden = gfc_find_typebound_proc (super_type, NULL,
 					    stree->name, true, NULL);
 
-      if (overridden && overridden->n.tb)
-	stree->n.tb->overridden = overridden->n.tb;
+      if (overridden)
+	{
+	  if (overridden->n.tb)
+	    stree->n.tb->overridden = overridden->n.tb;
 
-      if (overridden && check_typebound_override (stree, overridden) == FAILURE)
-	goto error;
+	  if (gfc_check_typebound_override (stree, overridden) == FAILURE)
+	    goto error;
+	}
     }
 
   /* See if there's a name collision with a component directly in this type.  */
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c	(revision 177528)
+++ gcc/fortran/dependency.c	(working copy)
@@ -118,8 +118,8 @@ identical_array_ref (gfc_array_ref *a1, gfc_array_
 /* Return true for identical variables, checking for references if
    necessary.  Calls identical_array_ref for checking array sections.  */
 
-bool
-gfc_are_identical_variables (gfc_expr *e1, gfc_expr *e2)
+static bool
+are_identical_variables (gfc_expr *e1, gfc_expr *e2)
 {
   gfc_ref *r1, *r2;
 
@@ -169,7 +169,7 @@ identical_array_ref (gfc_array_ref *a1, gfc_array_
 	  break;
 
 	default:
-	  gfc_internal_error ("gfc_are_identical_variables: Bad type");
+	  gfc_internal_error ("are_identical_variables: Bad type");
 	}
       r1 = r1->next;
       r2 = r2->next;
@@ -421,7 +421,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
       return 1;
 
     case EXPR_VARIABLE:
-      if (gfc_are_identical_variables (e1, e2))
+      if (are_identical_variables (e1, e2))
 	return 0;
       else
 	return -2;
@@ -438,7 +438,12 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
       if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0
 	  && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0)
 	return 0;
-      /* TODO Handle commutative binary operators here?  */
+      else if (e1->value.op.op == INTRINSIC_TIMES
+	       && gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2) == 0
+	       && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1) == 0)
+	/* Commutativity of multiplication.  */
+	return 0;
+
       return -2;
 
     case EXPR_FUNCTION:
@@ -451,11 +456,11 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 }
 
 
-/* Returns 1 if the two ranges are the same, 0 if they are not, and def
-   if the results are indeterminate.  N is the dimension to compare.  */
+/* Returns 1 if the two ranges are the same and 0 if they are not (or if the
+   results are indeterminate). 'n' is the dimension to compare.  */
 
-int
-gfc_is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n, int def)
+static int
+is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n)
 {
   gfc_expr *e1;
   gfc_expr *e2;
@@ -472,25 +477,19 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
   if (e1 && !e2)
     {
       i = gfc_expr_is_one (e1, -1);
-      if (i == -1)
-	return def;
-      else if (i == 0)
+      if (i == -1 || i == 0)
 	return 0;
     }
   else if (e2 && !e1)
     {
       i = gfc_expr_is_one (e2, -1);
-      if (i == -1)
-	return def;
-      else if (i == 0)
+      if (i == -1 || i == 0)
 	return 0;
     }
   else if (e1 && e2)
     {
       i = gfc_dep_compare_expr (e1, e2);
-      if (i == -2)
-	return def;
-      else if (i != 0)
+      if (i != 0)
 	return 0;
     }
   /* The strides match.  */
@@ -509,12 +508,10 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 
       /* Check we have values for both.  */
       if (!(e1 && e2))
-	return def;
+	return 0;
 
       i = gfc_dep_compare_expr (e1, e2);
-      if (i == -2)
-	return def;
-      else if (i != 0)
+      if (i != 0)
 	return 0;
     }
 
@@ -532,12 +529,10 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 
       /* Check we have values for both.  */
       if (!(e1 && e2))
-	return def;
+	return 0;
 
       i = gfc_dep_compare_expr (e1, e2);
-      if (i == -2)
-	return def;
-      else if (i != 0)
+      if (i != 0)
 	return 0;
     }
 
@@ -1091,7 +1086,7 @@ check_section_vs_section (gfc_array_ref *l_ar, gfc
   int start_comparison;
 
   /* If they are the same range, return without more ado.  */
-  if (gfc_is_same_range (l_ar, r_ar, n, 0))
+  if (is_same_range (l_ar, r_ar, n))
     return GFC_DEP_EQUAL;
 
   l_start = l_ar->start[n];
Index: gcc/fortran/dependency.h
===================================================================
--- gcc/fortran/dependency.h	(revision 177528)
+++ gcc/fortran/dependency.h	(working copy)
@@ -37,11 +37,8 @@ gfc_expr *gfc_get_noncopying_intrinsic_argument (g
 int gfc_check_fncall_dependency (gfc_expr *, sym_intent, gfc_symbol *,
 				 gfc_actual_arglist *, gfc_dep_check);
 int gfc_check_dependency (gfc_expr *, gfc_expr *, bool);
-int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, int);
+/*int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, bool);*/
 int gfc_expr_is_one (gfc_expr *, int);
 
 int gfc_dep_resolver(gfc_ref *, gfc_ref *, gfc_reverse *);
 int gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
-
-bool gfc_are_identical_variables (gfc_expr *, gfc_expr *);
-

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-07  2:11                               ` Janus Weil
@ 2011-08-07  3:39                                 ` Mikael Morin
  2011-08-07 10:57                                 ` Thomas Koenig
  1 sibling, 0 replies; 43+ messages in thread
From: Mikael Morin @ 2011-08-07  3:39 UTC (permalink / raw)
  To: fortran; +Cc: Janus Weil, Thomas Koenig, gcc-patches

On Sunday 07 August 2011 00:21:46 Janus Weil wrote:
> Well, ok. After this amount of discussion, how about we start with the
> easy things: Here is a preparational patch (basically a subset of the
> previous one), which does not do any real changes yet, only some
> preparation and cleanup:
> * It moves check_typebound_override to interface.c and prefixes it
> with gfc_ (I don't like moving and modifying it at the same time).
> * It add the commutativity of multiplication in gfc_dep_compare_expr.
> * It does some minor cleanup in dependency.c (making two routines
> static and removing an unused argument).
> 
> Ok for trunk?
> 
> Cheers,
> Janus
> 
> 
> 2011-08-06  Janus Weil  <janus@gcc.gnu.org>
> 
> 	PR fortran/49638
> 	* dependency.h (gfc_is_same_range,gfc_are_identical_variables): Remove
> 	two prototypes.
> 	* dependency.c (gfc_are_identical_variables): Made static and renamed.
I think both the old and the new name should appear. 
Usually I use (old, new): Rename the former to the latter

> 	(gfc_dep_compare_expr): Renamed 'gfc_are_identical_variables', handle
> 	commutativity of multiplication.
> 	(gfc_is_same_range): Made static and renamed, removed argument 'def'.
Same here.

> 	(check_section_vs_section): Renamed 'gfc_is_same_range'.
> 	* gfortran.h (gfc_check_typebound_override): New prototype.
> 	* interface.c (gfc_check_typebound_override): Moved here from ...
> 	* resolv.c (check_typebound_override): ... here (and renamed).
> 	(resolve_typebound_procedure): Renamed 'check_typebound_override'.

Index: gcc/fortran/dependency.h
===================================================================
--- gcc/fortran/dependency.h    (revision 177528)
+++ gcc/fortran/dependency.h    (working copy)
@@ -37,11 +37,8 @@ gfc_expr *gfc_get_noncopying_intrinsic_argument (g
 int gfc_check_fncall_dependency (gfc_expr *, sym_intent, gfc_symbol *,
                                 gfc_actual_arglist *, gfc_dep_check);
 int gfc_check_dependency (gfc_expr *, gfc_expr *, bool);
-int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, int);
+/*int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, bool);*/
 int gfc_expr_is_one (gfc_expr *, int);
 identical_variables (gfc_expr *, gfc_expr *);

I would just remove it together with the commented code in trans-array.c.
Nobody is likely to use it soon, and it remains available through svn if 
needed.

Otherwise OK.
Please give Thomas (or others) some time to comment before commiting.

Mikael

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-07  2:11                               ` Janus Weil
  2011-08-07  3:39                                 ` Mikael Morin
@ 2011-08-07 10:57                                 ` Thomas Koenig
  2011-08-07 11:00                                   ` Janus Weil
  1 sibling, 1 reply; 43+ messages in thread
From: Thomas Koenig @ 2011-08-07 10:57 UTC (permalink / raw)
  To: Janus Weil; +Cc: Mikael Morin, fortran, gcc-patches

Hi Janus,

> Here is a preparational patch (basically a subset of the
> previous one), which does not do any real changes yet, only some
> preparation and cleanup:
> * It moves check_typebound_override to interface.c and prefixes it
> with gfc_ (I don't like moving and modifying it at the same time).
> * It add the commutativity of multiplication in gfc_dep_compare_expr.
> * It does some minor cleanup in dependency.c (making two routines
> static and removing an unused argument).
>
> Ok for trunk?
>
> Cheers,
> Janus
>
>
> 2011-08-06  Janus Weil<janus@gcc.gnu.org>
>
> 	PR fortran/49638
> 	* dependency.h (gfc_is_same_range,gfc_are_identical_variables): Remove
> 	two prototypes.
> 	* dependency.c (gfc_are_identical_variables): Made static and renamed.
> 	(gfc_dep_compare_expr): Renamed 'gfc_are_identical_variables', handle
> 	commutativity of multiplication.
> 	(gfc_is_same_range): Made static and renamed, removed argument 'def'.
> 	(check_section_vs_section): Renamed 'gfc_is_same_range'.
> 	* gfortran.h (gfc_check_typebound_override): New prototype.
> 	* interface.c (gfc_check_typebound_override): Moved here from ...
> 	* resolv.c (check_typebound_override): ... here (and renamed).
> 	(resolve_typebound_procedure): Renamed 'check_typebound_override'.

OK from my side (given Mikael's comments), provided you spell resolve.c 
with two e :-)

Regards

	Thomas

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-07 10:57                                 ` Thomas Koenig
@ 2011-08-07 11:00                                   ` Janus Weil
  2011-08-07 11:24                                     ` Janus Weil
  0 siblings, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-07 11:00 UTC (permalink / raw)
  To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches

2011/8/7 Thomas Koenig <tkoenig@netcologne.de>:
> Hi Janus,
>
>> Here is a preparational patch (basically a subset of the
>> previous one), which does not do any real changes yet, only some
>> preparation and cleanup:
>> * It moves check_typebound_override to interface.c and prefixes it
>> with gfc_ (I don't like moving and modifying it at the same time).
>> * It add the commutativity of multiplication in gfc_dep_compare_expr.
>> * It does some minor cleanup in dependency.c (making two routines
>> static and removing an unused argument).
>>
>> Ok for trunk?
>>
>> Cheers,
>> Janus
>>
>>
>> 2011-08-06  Janus Weil<janus@gcc.gnu.org>
>>
>>        PR fortran/49638
>>        * dependency.h (gfc_is_same_range,gfc_are_identical_variables):
>> Remove
>>        two prototypes.
>>        * dependency.c (gfc_are_identical_variables): Made static and
>> renamed.
>>        (gfc_dep_compare_expr): Renamed 'gfc_are_identical_variables',
>> handle
>>        commutativity of multiplication.
>>        (gfc_is_same_range): Made static and renamed, removed argument
>> 'def'.
>>        (check_section_vs_section): Renamed 'gfc_is_same_range'.
>>        * gfortran.h (gfc_check_typebound_override): New prototype.
>>        * interface.c (gfc_check_typebound_override): Moved here from ...
>>        * resolv.c (check_typebound_override): ... here (and renamed).
>>        (resolve_typebound_procedure): Renamed 'check_typebound_override'.
>
> OK from my side (given Mikael's comments), provided you spell resolve.c with
> two e :-)

Thanks, guys. Committed as r177545 (including your comments).

Cheers,
Janus

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-07 11:00                                   ` Janus Weil
@ 2011-08-07 11:24                                     ` Janus Weil
  2011-08-07 12:39                                       ` Thomas Koenig
  0 siblings, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-07 11:24 UTC (permalink / raw)
  To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 1149 bytes --]

>> OK from my side (given Mikael's comments), provided you spell resolve.c with
>> two e :-)
>
> Thanks, guys. Committed as r177545 (including your comments).


Ok, with the 'trivial' parts out of the way, the remainder of my
previously proposed patch becomes rather compact (see attachment).

Thomas' ongoing criticism is that rejecting all nonzero return values
of 'gfc_dep_compare_expr' will reject too much (i.e. cases where we
can not prove that the expressions are equal, but they may still be).

My feeling is that only throwing a warning for a result of '-2' is too
weak, because the majority of cases will have that result (just think
'len=3' vs. 'len=n').

Instead I could offer to try to extend the return values of
'gfc_dep_compare_expr' to distinguish between the following cases
(which right now would both result in '-2'):

a) We can not determine the relationship between both expressions, but
we know they are different for certain input values. (This case would
include e.g. different expr_type)

b) We cannot make any statement.

Is this the way to go? Or are there any other proposals for resolving
this argument?

Cheers,
Janus

[-- Attachment #2: pr49638_v3.diff --]
[-- Type: text/x-diff, Size: 2144 bytes --]

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 177545)
+++ gcc/fortran/interface.c	(working copy)
@@ -3556,15 +3556,25 @@ gfc_check_typebound_override (gfc_symtree* proc, g
 	}
 
       /* 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
+	  && gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
+				   old_target->result->ts.u.cl->length) != 0)
+	{
+	  gfc_error ("Character length mismatch between '%s' at '%L' "
+		     "and overridden FUNCTION", proc->name, &where);
+	  return FAILURE;
+	}
     }
 
   /* If the overridden binding is PUBLIC, the overriding one must not be
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c	(revision 177545)
+++ gcc/fortran/dependency.c	(working copy)
@@ -123,8 +123,18 @@ are_identical_variables (gfc_expr *e1, gfc_expr *e
 {
   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.  */
 

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-07 11:24                                     ` Janus Weil
@ 2011-08-07 12:39                                       ` Thomas Koenig
  2011-08-07 18:49                                         ` Janus Weil
  0 siblings, 1 reply; 43+ messages in thread
From: Thomas Koenig @ 2011-08-07 12:39 UTC (permalink / raw)
  To: Janus Weil; +Cc: Mikael Morin, fortran, gcc-patches

Am 07.08.2011 12:56, schrieb Janus Weil:
> +      /* Check string length.  */
> +      if (proc_target->result->ts.type == BT_CHARACTER
> +	&&  proc_target->result->ts.u.cl&&  old_target->result->ts.u.cl
> +	&&  gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
> +				   old_target->result->ts.u.cl->length) != 0)
> +	{
> +	  gfc_error ("Character length mismatch between '%s' at '%L' "
> +		     "and overridden FUNCTION", proc->name,&where);
> +	  return FAILURE;
> +	}
>       }

Well, let's make this into (again, typing the patch directly into
e-mail)

	
       /* 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 -3:
             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 length mismatch between '%s' at '%L' "
                         "and overriden FUNCTION, proc->name, &where);
            break;

	case 0:
	    break;

	default:
	    gfc_internal_error ("Unexpected return of gfc_dep_compare_expr";
            break;
        }

and then work on extending gfc_dep_compare_expr to return -3 for more 
cases.  I can help with that.

Regards

	Thomas

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-07 12:39                                       ` Thomas Koenig
@ 2011-08-07 18:49                                         ` Janus Weil
  2011-08-07 20:08                                           ` Janus Weil
  2011-08-07 20:31                                           ` Thomas Koenig
  0 siblings, 2 replies; 43+ messages in thread
From: Janus Weil @ 2011-08-07 18:49 UTC (permalink / raw)
  To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 1531 bytes --]

2011/8/7 Thomas Koenig <tkoenig@netcologne.de>:
> Am 07.08.2011 12:56, schrieb Janus Weil:
>>
>> +      /* Check string length.  */
>> +      if (proc_target->result->ts.type == BT_CHARACTER
>> +       &&  proc_target->result->ts.u.cl&&  old_target->result->ts.u.cl
>> +       &&  gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
>> +                                  old_target->result->ts.u.cl->length) !=
>> 0)
>> +       {
>> +         gfc_error ("Character length mismatch between '%s' at '%L' "
>> +                    "and overridden FUNCTION", proc->name,&where);
>> +         return FAILURE;
>> +       }
>>      }
>
> Well, let's make this into (again, typing the patch directly into
> e-mail)
>
>  [...]
>
> and then work on extending gfc_dep_compare_expr to return -3 for more cases.
>  I can help with that.

Alright then. How about this: I'll commit the attached verision of the
patch (including your suggestions), and we start messing with the
return values afterwards? Patch is regtested on
x86_64-unknown-linux-gnu. I hope the test case is sufficient for a
start.

Cheers,
Janus


2011-08-07  Janus Weil  <janus@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.

[-- Attachment #2: pr49638_v3.diff --]
[-- Type: text/x-diff, Size: 2578 bytes --]

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 177545)
+++ gcc/fortran/interface.c	(working copy)
@@ -3556,15 +3556,43 @@ gfc_check_typebound_override (gfc_symtree* proc, g
 	}
 
       /* 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
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c	(revision 177545)
+++ gcc/fortran/dependency.c	(working copy)
@@ -123,8 +123,18 @@ are_identical_variables (gfc_expr *e1, gfc_expr *e
 {
   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.  */
 

[-- Attachment #3: typebound_override_1.f90 --]
[-- Type: text/x-fortran, Size: 2317 bytes --]

! { dg-do compile }
!
! PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
!
! Original test case contributed by Hans-Werner Boschmann <boschmann@tp1.physik.uni-siegen.de>

module m

  implicit none

  type :: t1
   contains
     procedure, nopass :: a => a1
     procedure, nopass :: b => b1
     procedure, nopass :: c => c1
     procedure, nopass :: d => d1
     procedure, nopass :: e => e1
  end type

  type, extends(t1) :: t2
   contains
     procedure, nopass :: a => a2  ! { dg-error "Character length mismatch" }
     procedure, nopass :: b => b2  ! { dg-error "should have matching result types and ranks" }
     procedure, nopass :: c => c2  ! { dg-warning "Possible character length mismatch" }
     procedure, nopass :: d => d2  ! valid, check for commutativity (+,*)
     procedure, nopass :: e => e2  ! { dg-warning "Possible character length mismatch" }
  end type

contains

  function a1 ()
    character(len=6) :: a1
  end function

  function a2 ()
    character(len=7) :: a2
  end function

  function b1 ()
    integer :: b1
  end function

  function b2 ()
    integer, dimension(2) :: b2
  end function

  function c1 (x)
    integer, intent(in) :: x
    character(2*x) :: c1
  end function

  function c2 (x)
    integer, intent(in) :: x
    character(3*x) :: c2
  end function

  function d1 (y)
    integer, intent(in) :: y
    character(2*y+1) :: d1
  end function

  function d2 (y)
    integer, intent(in) :: y
    character(1+y*2) :: d2
  end function

  function e1 (z)
    integer, intent(in) :: z
    character(3) :: e1
  end function

  function e2 (z)
    integer, intent(in) :: z
    character(z) :: e2
  end function

end module m




module w1

 implicit none

 integer :: n = 1

 type :: tt1
 contains
   procedure, nopass :: aa => aa1
 end type

contains

 function aa1 (m)
  integer, intent(in) :: m
  character(n+m) :: aa1
 end function

end module w1


module w2

 use w1, only : tt1

 implicit none

 integer :: n = 2

 type, extends(tt1) :: tt2
 contains
   procedure, nopass :: aa => aa2  ! { dg-warning "Possible character length mismatch" }
 end type

contains

 function aa2 (m)
  integer, intent(in) :: m
  character(n+m) :: aa2
 end function

end module w2

! { dg-final { cleanup-modules "m w1 w2" } }

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-07 18:49                                         ` Janus Weil
@ 2011-08-07 20:08                                           ` Janus Weil
  2011-08-07 20:31                                           ` Thomas Koenig
  1 sibling, 0 replies; 43+ messages in thread
From: Janus Weil @ 2011-08-07 20:08 UTC (permalink / raw)
  To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches

2011/8/7 Janus Weil <janus@gcc.gnu.org>:
> 2011/8/7 Thomas Koenig <tkoenig@netcologne.de>:
>> Am 07.08.2011 12:56, schrieb Janus Weil:
>>>
>>> +      /* Check string length.  */
>>> +      if (proc_target->result->ts.type == BT_CHARACTER
>>> +       &&  proc_target->result->ts.u.cl&&  old_target->result->ts.u.cl
>>> +       &&  gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
>>> +                                  old_target->result->ts.u.cl->length) !=
>>> 0)
>>> +       {
>>> +         gfc_error ("Character length mismatch between '%s' at '%L' "
>>> +                    "and overridden FUNCTION", proc->name,&where);
>>> +         return FAILURE;
>>> +       }
>>>      }
>>
>> Well, let's make this into (again, typing the patch directly into
>> e-mail)
>>
>>  [...]
>>
>> and then work on extending gfc_dep_compare_expr to return -3 for more cases.
>>  I can help with that.
>
> Alright then. How about this: I'll commit the attached verision of the
> patch (including your suggestions), and we start messing with the
> return values afterwards? Patch is regtested on
> x86_64-unknown-linux-gnu. I hope the test case is sufficient for a
> start.
>
> Cheers,
> Janus
>
>
> 2011-08-07  Janus Weil  <janus@gcc.gnu.org>

Sorry, completely forgot to mention Thomas in the ChangeLog. Of course
this should be

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

Cheers,
Janus



>
>        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.
>

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-07 18:49                                         ` Janus Weil
  2011-08-07 20:08                                           ` Janus Weil
@ 2011-08-07 20:31                                           ` Thomas Koenig
  2011-08-07 23:30                                             ` Janus Weil
  2011-08-13 16:30                                             ` Janus Weil
  1 sibling, 2 replies; 43+ messages in thread
From: Thomas Koenig @ 2011-08-07 20:31 UTC (permalink / raw)
  To: Janus Weil; +Cc: Mikael Morin, fortran, gcc-patches

Am 07.08.2011 19:05, schrieb Janus Weil:
> 2011/8/7 Thomas Koenig<tkoenig@netcologne.de>:
>> Am 07.08.2011 12:56, schrieb Janus Weil:
>>>
>>> +      /* Check string length.  */
>>> +      if (proc_target->result->ts.type == BT_CHARACTER
>>> +&&    proc_target->result->ts.u.cl&&    old_target->result->ts.u.cl
>>> +&&    gfc_dep_compare_expr (proc_target->result->ts.u.cl->length,
>>> +                                  old_target->result->ts.u.cl->length) !=
>>> 0)
>>> +       {
>>> +         gfc_error ("Character length mismatch between '%s' at '%L' "
>>> +                    "and overridden FUNCTION", proc->name,&where);
>>> +         return FAILURE;
>>> +       }
>>>       }
>>
>> Well, let's make this into (again, typing the patch directly into
>> e-mail)
>>
>>   [...]
>>
>> and then work on extending gfc_dep_compare_expr to return -3 for more cases.
>>   I can help with that.
>
> Alright then. How about this: I'll commit the attached verision of the
> patch (including your suggestions), and we start messing with the
> return values afterwards? Patch is regtested on
> x86_64-unknown-linux-gnu. I hope the test case is sufficient for a
> start.

This is OK.  Thanks for the patch (and for bearing with me ;-)

When extending the values of gfc_dep_compare_expr, we will need to go
through all its uses (making sure we change == -2 to <= -2).

Regards

	Thomas

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-07 20:31                                           ` Thomas Koenig
@ 2011-08-07 23:30                                             ` Janus Weil
  2011-08-13 16:30                                             ` Janus Weil
  1 sibling, 0 replies; 43+ messages in thread
From: Janus Weil @ 2011-08-07 23:30 UTC (permalink / raw)
  To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches

>> Alright then. How about this: I'll commit the attached verision of the
>> patch (including your suggestions), and we start messing with the
>> return values afterwards? Patch is regtested on
>> x86_64-unknown-linux-gnu. I hope the test case is sufficient for a
>> start.
>
> This is OK.  Thanks for the patch (and for bearing with me ;-)

Well, thanks for the thorough discussion :)

Committed as r177550.


> When extending the values of gfc_dep_compare_expr, we will need to go
> through all its uses (making sure we change == -2 to <= -2).

Right. I will try to take care of that during the coming week (unless
you beat me to it).

Cheers,
Janus

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-07 20:31                                           ` Thomas Koenig
  2011-08-07 23:30                                             ` Janus Weil
@ 2011-08-13 16:30                                             ` Janus Weil
  2011-08-19 12:30                                               ` Janus Weil
  1 sibling, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-13 16:30 UTC (permalink / raw)
  To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 998 bytes --]

Hi Thomas, hi all,

2011/8/7 Thomas Koenig <tkoenig@netcologne.de>:
> When extending the values of gfc_dep_compare_expr, we will need to go
> through all its uses (making sure we change == -2 to <= -2).

attached is a patch which makes a start with this.

For now, it changes the return value to "-3" for two cases:
1) different expr_types
2) non-identical variables

I tried to take care of all places which are checking for a return
value of "-2" and I hope I missed none.

Any objections or ok for trunk? (Regtested successfully.)

Cheers,
Janus


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

	PR fortran/49638
	* dependency.c (gfc_dep_compare_expr): Add new result value "-3".
	(gfc_check_element_vs_section,gfc_check_element_vs_element): Handle
	result value "-3".
        * frontend-passes.c (optimize_comparison): Ditto.
	* interface.c (gfc_check_typebound_override): Ditto.


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

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

[-- Attachment #2: pr49638_part3.diff --]
[-- Type: text/x-diff, Size: 5205 bytes --]

Index: gcc/testsuite/gfortran.dg/typebound_override_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_override_1.f90	(revision 177733)
+++ gcc/testsuite/gfortran.dg/typebound_override_1.f90	(working copy)
@@ -23,7 +23,7 @@ module m
      procedure, nopass :: b => b2  ! { dg-error "should have matching result types and ranks" }
      procedure, nopass :: c => c2  ! { dg-warning "Possible character length mismatch" }
      procedure, nopass :: d => d2  ! valid, check for commutativity (+,*)
-     procedure, nopass :: e => e2  ! { dg-warning "Possible character length mismatch" }
+     procedure, nopass :: e => e2  ! { dg-error "Character length mismatch" }
   end type
 
 contains
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 177733)
+++ gcc/fortran/interface.c	(working copy)
@@ -3574,7 +3574,8 @@ gfc_check_typebound_override (gfc_symtree* proc, g
 	  switch (compval)
 	  {
 	    case -1:
-	    case 1:
+	    case  1:
+	    case -3:
 	      gfc_error ("Character length mismatch between '%s' at '%L' and "
 			 "overridden FUNCTION", proc->name, &where);
 	      return FAILURE;
Index: gcc/fortran/frontend-passes.c
===================================================================
--- gcc/fortran/frontend-passes.c	(revision 177733)
+++ gcc/fortran/frontend-passes.c	(working copy)
@@ -682,7 +682,7 @@ optimize_comparison (gfc_expr *e, gfc_intrinsic_op
 	  && op1->ts.type != BT_COMPLEX && op2->ts.type != BT_COMPLEX))
     {
       eq = gfc_dep_compare_expr (op1, op2);
-      if (eq == -2)
+      if (eq <= -2)
 	{
 	  /* Replace A // B < A // C with B < C, and A // B < C // B
 	     with A < C.  */
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c	(revision 177733)
+++ gcc/fortran/dependency.c	(working copy)
@@ -230,8 +230,12 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr
 	return -2;      
 }
 
-/* Compare two values.  Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2,
-   and -2 if the relationship could not be determined.  */
+/* Compare two expressions.  Return values:
+   * +1 if e1 > e2
+   * 0 if e1 == e2
+   * -1 if e1 < e2
+   * -2 if the relationship could not be determined
+   * -3 if e1 /= e2, but we cannot tell which one is larger.  */
 
 int
 gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
@@ -304,9 +308,9 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
 	  if (l == 0 && r == 0)
 	    return 0;
-	  if (l == 0 && r != -2)
+	  if (l == 0 && r > -2)
 	    return r;
-	  if (l != -2 && r == 0)
+	  if (l > -2 && r == 0)
 	    return l;
 	  if (l == 1 && r == 1)
 	    return 1;
@@ -317,9 +321,9 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1);
 	  if (l == 0 && r == 0)
 	    return 0;
-	  if (l == 0 && r != -2)
+	  if (l == 0 && r > -2)
 	    return r;
-	  if (l != -2 && r == 0)
+	  if (l > -2 && r == 0)
 	    return l;
 	  if (l == 1 && r == 1)
 	    return 1;
@@ -354,9 +358,9 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
 	  if (l == 0 && r == 0)
 	    return 0;
-	  if (l != -2 && r == 0)
+	  if (l > -2 && r == 0)
 	    return l;
-	  if (l == 0 && r != -2)
+	  if (l == 0 && r > -2)
 	    return -r;
 	  if (l == 1 && r == -1)
 	    return 1;
@@ -375,8 +379,8 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
       l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
       r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
 
-      if (l == -2)
-	return -2;
+      if (l <= -2)
+	return l;
 
       if (l == 0)
 	{
@@ -387,7 +391,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 	  if (e1_left->expr_type == EXPR_CONSTANT
 	      && e2_left->expr_type == EXPR_CONSTANT
 	      && e1_left->value.character.length
-	        != e2_left->value.character.length)
+		 != e2_left->value.character.length)
 	    return -2;
 	  else
 	    return r;
@@ -411,7 +415,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
     }
 
   if (e1->expr_type != e2->expr_type)
-    return -2;
+    return -3;
 
   switch (e1->expr_type)
     {
@@ -434,7 +438,7 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
       if (are_identical_variables (e1, e2))
 	return 0;
       else
-	return -2;
+	return -3;
 
     case EXPR_OP:
       /* Intrinsic operators are the same if their operands are the same.  */
@@ -1406,7 +1410,7 @@ gfc_check_element_vs_section( gfc_ref *lref, gfc_r
       if (!start || !end)
 	return GFC_DEP_OVERLAP;
       s = gfc_dep_compare_expr (start, end);
-      if (s == -2)
+      if (s <= -2)
 	return GFC_DEP_OVERLAP;
       /* Assume positive stride.  */
       if (s == -1)
@@ -1553,7 +1557,7 @@ gfc_check_element_vs_element (gfc_ref *lref, gfc_r
   if (contains_forall_index_p (r_start) || contains_forall_index_p (l_start))
     return GFC_DEP_OVERLAP;
 
-  if (i != -2)
+  if (i > -2)
     return GFC_DEP_NODEP;
   return GFC_DEP_EQUAL;
 }

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-13 16:30                                             ` Janus Weil
@ 2011-08-19 12:30                                               ` Janus Weil
  2011-08-19 12:48                                                 ` Mikael Morin
  0 siblings, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-19 12:30 UTC (permalink / raw)
  To: Thomas Koenig; +Cc: Mikael Morin, fortran, gcc-patches

Ping! (Maybe I should have posted the follow-up patch in a separate
thread to make it more visible.)




2011/8/13 Janus Weil <janus@gcc.gnu.org>:
> Hi Thomas, hi all,
>
> 2011/8/7 Thomas Koenig <tkoenig@netcologne.de>:
>> When extending the values of gfc_dep_compare_expr, we will need to go
>> through all its uses (making sure we change == -2 to <= -2).
>
> attached is a patch which makes a start with this.
>
> For now, it changes the return value to "-3" for two cases:
> 1) different expr_types
> 2) non-identical variables
>
> I tried to take care of all places which are checking for a return
> value of "-2" and I hope I missed none.
>
> Any objections or ok for trunk? (Regtested successfully.)
>
> Cheers,
> Janus
>
>
> 2011-08-13  Janus Weil  <janus@gcc.gnu.org>
>
>        PR fortran/49638
>        * dependency.c (gfc_dep_compare_expr): Add new result value "-3".
>        (gfc_check_element_vs_section,gfc_check_element_vs_element): Handle
>        result value "-3".
>        * frontend-passes.c (optimize_comparison): Ditto.
>        * interface.c (gfc_check_typebound_override): Ditto.
>
>
> 2011-08-13  Janus Weil  <janus@gcc.gnu.org>
>
>        PR fortran/49638
>        * gfortran.dg/typebound_override_1.f90: Modified.
>

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-19 12:30                                               ` Janus Weil
@ 2011-08-19 12:48                                                 ` Mikael Morin
  2011-08-19 13:37                                                   ` Tobias Burnus
  2011-08-20  6:13                                                   ` Janus Weil
  0 siblings, 2 replies; 43+ messages in thread
From: Mikael Morin @ 2011-08-19 12:48 UTC (permalink / raw)
  To: fortran; +Cc: Janus Weil, Thomas Koenig, gcc-patches

On Friday 19 August 2011 12:05:02 Janus Weil wrote:
> Ping! (Maybe I should have posted the follow-up patch in a separate
> thread to make it more visible.)
I saw it, had a quick glance, thought that Thomas would jump on it, and 
forgot. Sorry.

> 
> 2011/8/13 Janus Weil <janus@gcc.gnu.org>:
> > Hi Thomas, hi all,
> > 
> > 2011/8/7 Thomas Koenig <tkoenig@netcologne.de>:
> >> When extending the values of gfc_dep_compare_expr, we will need to go
> >> through all its uses (making sure we change == -2 to <= -2).
> > 
> > attached is a patch which makes a start with this.
> > 
> > For now, it changes the return value to "-3" for two cases:
> > 1) different expr_types
> > 2) non-identical variables
> > 
> > I tried to take care of all places which are checking for a return
> > value of "-2" and I hope I missed none.
> > 
> > Any objections or ok for trunk? (Regtested successfully.)
OK from my side for the code proper.

I have one comment though about this:
+/* Compare two expressions.  Return values:
+   * +1 if e1 > e2
+   * 0 if e1 == e2
+   * -1 if e1 < e2
+   * -2 if the relationship could not be determined
+   * -3 if e1 /= e2, but we cannot tell which one is larger.  */

I think this is misleading, as the function does not always return -3 when 
e1/=e2. There is for example (currently) no special handling for operators.
Here is an attempt at expressing it:
  * -3 in some cases where we could determine that e1 and e2 have different 
data dependencies (and thus are not guaranteed to have always the same value), 
but we cannot tell whether one is greater than the other.

Mikael

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-19 12:48                                                 ` Mikael Morin
@ 2011-08-19 13:37                                                   ` Tobias Burnus
  2011-08-20  6:13                                                   ` Janus Weil
  1 sibling, 0 replies; 43+ messages in thread
From: Tobias Burnus @ 2011-08-19 13:37 UTC (permalink / raw)
  To: Mikael Morin; +Cc: fortran, Janus Weil, Thomas Koenig, gcc-patches

On 08/19/2011 01:55 PM, Mikael Morin wrote:
> OK from my side for the code proper.
>
> I have one comment though about this:
> +/* Compare two expressions.  Return values:
> +   * +1 if e1>  e2
> +   * 0 if e1 == e2
> +   * -1 if e1<  e2
> +   * -2 if the relationship could not be determined
> +   * -3 if e1 /= e2, but we cannot tell which one is larger.  */
>
> I think this is misleading, as the function does not always return -3 when
> e1/=e2. There is for example (currently) no special handling for operators.
> Here is an attempt at expressing it:
>    * -3 in some cases where we could determine that e1 and e2 have different
> data dependencies (and thus are not guaranteed to have always the same value),
> but we cannot tell whether one is greater than the other.

Besides that issue, I am wondering whether we shouldn't start to use an 
ENUM for those. I think for "<" vs. "==" vs. ">" one can use a number 
(-1, 0, 1) and then compare the result against 0 (>0, == 0 etc.).

However, for 5 values, I think it makes sense to do something else 
otherwise, someone write "... < 0" which not only matches -1 but also -2 
or -3.

I think this does not block the committal but one should think about 
whether one should do it as follow up.

Tobias,
who has not read the patch.

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-19 12:48                                                 ` Mikael Morin
  2011-08-19 13:37                                                   ` Tobias Burnus
@ 2011-08-20  6:13                                                   ` Janus Weil
  2011-08-20  7:25                                                     ` Mikael Morin
  1 sibling, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-20  6:13 UTC (permalink / raw)
  To: Mikael Morin; +Cc: fortran, Thomas Koenig, gcc-patches

>> > 2011/8/7 Thomas Koenig <tkoenig@netcologne.de>:
>> >> When extending the values of gfc_dep_compare_expr, we will need to go
>> >> through all its uses (making sure we change == -2 to <= -2).
>> >
>> > attached is a patch which makes a start with this.
>> >
>> > For now, it changes the return value to "-3" for two cases:
>> > 1) different expr_types
>> > 2) non-identical variables
>> >
>> > I tried to take care of all places which are checking for a return
>> > value of "-2" and I hope I missed none.
>> >
>> > Any objections or ok for trunk? (Regtested successfully.)
> OK from my side for the code proper.

Thanks for the review.

> I have one comment though about this:
> +/* Compare two expressions.  Return values:
> +   * +1 if e1 > e2
> +   * 0 if e1 == e2
> +   * -1 if e1 < e2
> +   * -2 if the relationship could not be determined
> +   * -3 if e1 /= e2, but we cannot tell which one is larger.  */
>
> I think this is misleading, as the function does not always return -3 when
> e1/=e2.

That's right. However, the same argument applies to the other values
as well: The function does not always return 0 if e1==e2. There could
be cases where the arguments are algebraically equal, but we fail to
detect this (example: A+B+C vs C+B+A). This sort of "uncertainty" was
not introduced by me, but was present before, and is not special to
the value "-3".

Describing the value -2 as "relationship could not be determined" sort
of implies that this can happen. So I would tend to leave the
description as it is.

> There is for example (currently) no special handling for operators.

Well, unfortunately one cannot just return "-3" for non-matching
operators. Just think of cases like A*(B+C) vs A*B+A*C. One could try
to handle such cases in a follow-up patch.

I'll commit the patch (as posted) tomorrow, if Mikael agrees that the
description is ok.

Also I like Tobias' idea of using an enum, but I'll leave it for a follow-up.

Cheers,
Janus

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-20  6:13                                                   ` Janus Weil
@ 2011-08-20  7:25                                                     ` Mikael Morin
  2011-08-20 21:03                                                       ` Janus Weil
  0 siblings, 1 reply; 43+ messages in thread
From: Mikael Morin @ 2011-08-20  7:25 UTC (permalink / raw)
  To: fortran; +Cc: Janus Weil, Thomas Koenig, gcc-patches

On Friday 19 August 2011 23:54:45 Janus Weil wrote:
> > I have one comment though about this:
> > +/* Compare two expressions.  Return values:
> > +   * +1 if e1 > e2
> > +   * 0 if e1 == e2
> > +   * -1 if e1 < e2
> > +   * -2 if the relationship could not be determined
> > +   * -3 if e1 /= e2, but we cannot tell which one is larger.  */
> > 
> > I think this is misleading, as the function does not always return -3
> > when e1/=e2.
> 
> That's right. However, the same argument applies to the other values
> as well: The function does not always return 0 if e1==e2. There could
> be cases where the arguments are algebraically equal, but we fail to
> detect this (example: A+B+C vs C+B+A). This sort of "uncertainty" was
> not introduced by me, but was present before, and is not special to
> the value "-3".
> 
> Describing the value -2 as "relationship could not be determined" sort
> of implies that this can happen. So I would tend to leave the
> description as it is.
OK, this comment really bugged me, but it's not that bad on second thought.

> 
> > There is for example (currently) no special handling for operators.
> 
> Well, unfortunately one cannot just return "-3" for non-matching
> operators. Just think of cases like A*(B+C) vs A*B+A*C. 
Ah yes. I was thinking expressions themselves were compared; but only their 
values are. 

> One could try to handle such cases in a follow-up patch.
If you want. I wasn't asking you (or anyone else) to do it. 

> 
> I'll commit the patch (as posted) tomorrow, if Mikael agrees that the
> description is ok.
It's fine. Thanks.

Mikael.

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-20  7:25                                                     ` Mikael Morin
@ 2011-08-20 21:03                                                       ` Janus Weil
  2011-08-20 21:31                                                         ` Mikael Morin
  0 siblings, 1 reply; 43+ messages in thread
From: Janus Weil @ 2011-08-20 21:03 UTC (permalink / raw)
  To: Mikael Morin; +Cc: fortran, Thomas Koenig, gcc-patches

>> > There is for example (currently) no special handling for operators.
>>
>> Well, unfortunately one cannot just return "-3" for non-matching
>> operators. Just think of cases like A*(B+C) vs A*B+A*C.
> Ah yes. I was thinking expressions themselves were compared; but only their
> values are.

I'm not sure I'm getting you right here. Of course we do compare the
expressions themselves. However, for example things like commutativity
of operators are taken into account, meaning we compare "A+B" equal to
"B+A" (A and B being arbitrary expressions).

Taking care of other algebraic transformations (like e.g.
distributivity as mentioned above) will be a bit harder. And the
question is we are even allowed to do it. Earlier in this thread Steve
mentioned restrictions like

Note 7.18.  X*(Y-Z) -> X*Y - X*Z is a forbidden transformation
(there is no noted restriction on Z > 0).

>> I'll commit the patch (as posted) tomorrow, if Mikael agrees that the
>> description is ok.
> It's fine. Thanks.

Committed as r177932. Thanks again for your review and comments.

Cheers,
Janus

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-20 21:03                                                       ` Janus Weil
@ 2011-08-20 21:31                                                         ` Mikael Morin
  2011-08-21 12:04                                                           ` Thomas Koenig
  0 siblings, 1 reply; 43+ messages in thread
From: Mikael Morin @ 2011-08-20 21:31 UTC (permalink / raw)
  To: fortran; +Cc: Janus Weil, Thomas Koenig, gcc-patches

On Saturday 20 August 2011 21:29:21 Janus Weil wrote:
> >> > There is for example (currently) no special handling for operators.
> >> 
> >> Well, unfortunately one cannot just return "-3" for non-matching
> >> operators. Just think of cases like A*(B+C) vs A*B+A*C.
> > 
> > Ah yes. I was thinking expressions themselves were compared; but only
> > their values are.
> 
> I'm not sure I'm getting you right here. Of course we do compare the
> expressions themselves. 
Yes, what I mean is...

> However, for example things like commutativity
> of operators are taken into account, meaning we compare "A+B" equal to
> "B+A" (A and B being arbitrary expressions).
... "A+B" and "B+A" are different expressions, with the same value.
And we return 0 (<=> equality) in that case. So we are interested in same-
value-ness, not same-expression-ness.
And we do compare expressions, because same expresssion ===> same value.
But different expression =/=> different value (as your example shows).

Oh well, nevermind.

Mikael

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-20 21:31                                                         ` Mikael Morin
@ 2011-08-21 12:04                                                           ` Thomas Koenig
  0 siblings, 0 replies; 43+ messages in thread
From: Thomas Koenig @ 2011-08-21 12:04 UTC (permalink / raw)
  To: Mikael Morin; +Cc: fortran, Janus Weil, gcc-patches

If we really wanted to do this The Right Way, there would be seven
cases to be considered, best expressed as three flags.  I'll call them
CAN_BE_LESS, CAN_BE_EQUAL and CAN_BE_MORE.

Comparing a vs. a+1 would yield CAN_BE_LESS for integers and
CAN_BE_LESS | CAN_BE_EQUAL for floats.

Comparing 3 vs. 4 would yield CAN_BE_LESS.

Comparing a vs. 5 would yield CAN_BE_LESS | CAN_BE_EQUAL | CAN_BE_MORE.

Comparing NaN against anything would yield 0.

And so on...

	Thomas

^ permalink raw reply	[flat|nested] 43+ messages in thread

* Re: [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
  2011-08-06 14:27     ` Janus Weil
  2011-08-06 16:07       ` Thomas Koenig
@ 2011-08-06 16:46       ` Janus Weil
  1 sibling, 0 replies; 43+ messages in thread
From: Janus Weil @ 2011-08-06 16:46 UTC (permalink / raw)
  To: Mikael Morin; +Cc: fortran, Thomas Koenig, gcc-patches

>> This lets me think that one should enable the comparison by name for dummy
>> arguments only. Other variables should compare normally.
>
> Good point. I have attached a new version of the patch, which adds
> this constraint, plus:
>
> 1) I have moved 'check_typebound_override' to interface.c and prefixed
> it with 'gfc_'.
>
> 2) I have added the 'var_name_only flag' also to
> gfc_are_identical_variables, gfc_dep_compare_functions,
> identical_array_ref, check_section_vs_section and gfc_is_same_range. I
> hope there is nothing else I missed.
>
> 3) I have made 'gfc_are_identical_variables' static and removed the
> gfc prefix (it does not seem to be used outside of dependency.c).
>
> 4) I have made 'gfc_is_same_range' static and removed the gfc prefix
> (there is only a commented out reference to it in trans-array.c, so I
> commented out the declaration in dependency.h, too). Also I removed
> the 'def' argument, which gets always passed a '0'.
>
> I will regtest this once more, construct some mildly complex test
> cases and add a ChangeLog.

Btw, this patch regtests cleanly (except for c_ptr_tests_16.f90, which
is PR 50004).

Cheers,
Janus

^ permalink raw reply	[flat|nested] 43+ messages in thread

end of thread, other threads:[~2011-08-21 10:01 UTC | newest]

Thread overview: 43+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2011-08-04 21:42 [Patch, Fortran, OOP] PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length Janus Weil
2011-08-05 17:26 ` Mikael Morin
2011-08-05 17:35   ` Janus Weil
2011-08-05 18:16     ` Mikael Morin
2011-08-05 21:23 ` Thomas Koenig
2011-08-05 22:06   ` Mikael Morin
2011-08-06 14:27     ` Janus Weil
2011-08-06 16:07       ` Thomas Koenig
2011-08-06 16:17         ` Mikael Morin
2011-08-06 16:24           ` Janus Weil
2011-08-06 16:59             ` Mikael Morin
2011-08-06 18:42               ` Steve Kargl
2011-08-06 16:45         ` Janus Weil
2011-08-06 16:54           ` Thomas Koenig
2011-08-06 17:10             ` Janus Weil
2011-08-06 17:40               ` Janus Weil
2011-08-06 18:27                 ` Mikael Morin
2011-08-06 18:37                   ` Janus Weil
2011-08-06 20:32                     ` Thomas Koenig
2011-08-06 21:11                       ` Janus Weil
2011-08-06 21:40                         ` Thomas Koenig
2011-08-06 21:59                           ` Janus Weil
2011-08-06 23:14                             ` Thomas Koenig
2011-08-07  2:11                               ` Janus Weil
2011-08-07  3:39                                 ` Mikael Morin
2011-08-07 10:57                                 ` Thomas Koenig
2011-08-07 11:00                                   ` Janus Weil
2011-08-07 11:24                                     ` Janus Weil
2011-08-07 12:39                                       ` Thomas Koenig
2011-08-07 18:49                                         ` Janus Weil
2011-08-07 20:08                                           ` Janus Weil
2011-08-07 20:31                                           ` Thomas Koenig
2011-08-07 23:30                                             ` Janus Weil
2011-08-13 16:30                                             ` Janus Weil
2011-08-19 12:30                                               ` Janus Weil
2011-08-19 12:48                                                 ` Mikael Morin
2011-08-19 13:37                                                   ` Tobias Burnus
2011-08-20  6:13                                                   ` Janus Weil
2011-08-20  7:25                                                     ` Mikael Morin
2011-08-20 21:03                                                       ` Janus Weil
2011-08-20 21:31                                                         ` Mikael Morin
2011-08-21 12:04                                                           ` Thomas Koenig
2011-08-06 16:46       ` Janus Weil

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).