[Patch, Fortran] Small fix for type-bound operators and NOPASS

[Daniel Kraft <d at domob dot eu>]

Hi all,

I just started to work on calling type-bound operators, and discovered a 
small bug with the last patch.  For type-bound operator procedures, 
there must be a passed-object dummy argument (makes sense) -- but that 
was not checked, and so it was ok to define some procedure as type-bound 
operator that has nothing to do with the type at all.

The attached patch fixes that.  I'm not sure if we should do a seperate 
check-in or just combine it with the large follow-up for calls; I think 
it is nothing we need to fix for now, but on the other hand it doesn't 
really belong to the calling-patch.  So what do you think?

If I should commit this right away, I'll add a ChangeLog and run a 
regression-test.  Would it then be ok for trunk?

Yours,
Daniel

--
Done:  Arc-Bar-Cav-Ran-Rog-Sam-Tou-Val-Wiz
To go: Hea-Kni-Mon-Pri

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 150622)
+++ gcc/fortran/resolve.c	(working copy)
@@ -8925,6 +8925,29 @@ resolve_typebound_generic (gfc_symbol* d
 }
 
 
+/* Retrieve the target-procedure of an operator binding and do some checks in
+   common for intrinsic and user-defined type-bound operators.  */
+
+static gfc_symbol*
+get_checked_tb_operator_target (gfc_tbp_generic* target, locus where)
+{
+  gfc_symbol* target_proc;
+
+  gcc_assert (target->specific && !target->specific->is_generic);
+  target_proc = target->specific->u.specific->n.sym;
+  gcc_assert (target_proc);
+
+  /* All operator bindings must have a passed-object dummy argument.  */
+  if (target->specific->nopass)
+    {
+      gfc_error ("Type-bound operator at %L can't be NOPASS", &where);
+      return NULL;
+    }
+
+  return target_proc;
+}
+
+
 /* Resolve a type-bound intrinsic operator.  */
 
 static gfc_try
@@ -8958,9 +8981,9 @@ resolve_typebound_intrinsic_op (gfc_symb
     {
       gfc_symbol* target_proc;
 
-      gcc_assert (target->specific && !target->specific->is_generic);
-      target_proc = target->specific->u.specific->n.sym;
-      gcc_assert (target_proc);
+      target_proc = get_checked_tb_operator_target (target, p->where);
+      if (!target_proc)
+	return FAILURE;
 
       if (!gfc_check_operator_interface (target_proc, op, p->where))
 	return FAILURE;
@@ -9019,9 +9042,9 @@ resolve_typebound_user_op (gfc_symtree* 
     {
       gfc_symbol* target_proc;
 
-      gcc_assert (target->specific && !target->specific->is_generic);
-      target_proc = target->specific->u.specific->n.sym;
-      gcc_assert (target_proc);
+      target_proc = get_checked_tb_operator_target (target, stree->n.tb->where);
+      if (!target_proc)
+	goto error;
 
       if (check_uop_procedure (target_proc, stree->n.tb->where) == FAILURE)
 	goto error;
Index: gcc/testsuite/gfortran.dg/typebound_operator_2.f03
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_operator_2.f03	(revision 150622)
+++ gcc/testsuite/gfortran.dg/typebound_operator_2.f03	(working copy)
@@ -13,8 +13,8 @@ MODULE m
     PROCEDURE, PASS :: onearg
     PROCEDURE, PASS :: onearg_alt => onearg
     PROCEDURE, PASS :: onearg_alt2 => onearg
+    PROCEDURE, NOPASS :: nopassed => onearg
     PROCEDURE, PASS :: threearg
-    PROCEDURE, NOPASS :: noarg
     PROCEDURE, PASS :: sub
     PROCEDURE, PASS :: sub2 ! { dg-error "must be a FUNCTION" }
     PROCEDURE, PASS :: func
@@ -26,10 +26,15 @@ MODULE m
 
     GENERIC :: OPERATOR(.UOPA.) => sub ! { dg-error "must be a FUNCTION" }
     GENERIC :: OPERATOR(.UOPB.) => threearg ! { dg-error "at most, two arguments" }
-    GENERIC :: OPERATOR(.UOPC.) => noarg ! { dg-error "at least one argument" }
+    ! We can't check for the 'at least one argument' error, because in this case
+    ! the procedure must be NOPASS and that other error is issued.  But of
+    ! course this should be alright.
 
     GENERIC :: OPERATOR(.UNARY.) => onearg_alt
     GENERIC, PRIVATE :: OPERATOR(.UNARY.) => onearg_alt2 ! { dg-error "must have the same access" }
+
+    GENERIC :: OPERATOR(.UNARYPRIME.) => nopassed ! { dg-error "can't be NOPASS" }
+    GENERIC :: OPERATOR(-) => nopassed ! { dg-error "can't be NOPASS" }
   END TYPE t
 
 CONTAINS
@@ -44,10 +49,6 @@ CONTAINS
     threearg = 42
   END FUNCTION threearg
 
-  INTEGER FUNCTION noarg ()
-    noarg = 42
-  END FUNCTION noarg
-
   LOGICAL FUNCTION func (me, b) ! { dg-error "must be a SUBROUTINE" }
     CLASS(t), INTENT(OUT) :: me
     CLASS(t), INTENT(IN) :: b