diff mbox

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

Message ID CAKwh3qjZCRFRfU+ivXwHVaJxLzvjSRshLFFLZCjQZAx56yHCMA@mail.gmail.com
State New
Headers show

Commit Message

Janus Weil Aug. 6, 2011, 6:19 p.m. UTC
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

Comments

Thomas Koenig Aug. 6, 2011, 6:55 p.m. UTC | #1
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
Janus Weil Aug. 6, 2011, 7:26 p.m. UTC | #2
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
Thomas Koenig Aug. 6, 2011, 8:31 p.m. UTC | #3
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
Janus Weil Aug. 6, 2011, 9:10 p.m. UTC | #4
>> 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
Thomas Koenig Aug. 6, 2011, 9:59 p.m. UTC | #5
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
diff mbox

Patch

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 *);
-