This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, Fortran] PR43256: [OOP] TBP with missing optional arg


Hi all,

here is the fix for a recently reported issue with type-bound
functions. Basically the problem was that type-bound functions were
not resolved correctly, because 'value.function.name' was already set
in 'resolve_compcall'. Then later in 'resolve_function' the
value.function.name field is checked to see if the function has
already been resolved, so that a type-bound function was actually
never resolved, and in consequence no NULL pointers were inserted for
missing optional args.

The hunk in 'resolve_compcall' fixed this PR's test case, but
introduced a couple of regressions. These were bugs that were
uncovered by the correct resolution of type-bound functions. With the
two additional hunks in resolve.c, the patch is regression-free on
x86_64-unknown-linux-gnu.

Ok for trunk?

Cheers,
Janus


2010-03-07  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/43256
	* resolve.c (resolve_compcall): Don't set 'value.function.name' here
	for TBPs, otherwise they will not be resolved properly.
	(resolve_function): Use 'value.function.esym' instead of
        'value.function.name' to check if we're dealing with a TBP.
	(check_class_members): Set correct type of passed object for all TBPs,
	not only generic ones, except if the type is abstract.

2010-03-07  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/43256
	* gfortran.dg/typebound_call_13.f03: New.
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 157262)
+++ gcc/fortran/resolve.c	(working copy)
@@ -2556,8 +2556,8 @@ resolve_function (gfc_expr *expr)
     }
 
   /* If this ia a deferred TBP with an abstract interface (which may
-     of course be referenced), expr->value.function.name will be set.  */
-  if (sym && sym->attr.abstract && !expr->value.function.name)
+     of course be referenced), expr->value.function.esym will be set.  */
+  if (sym && sym->attr.abstract && !expr->value.function.esym)
     {
       gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L",
 		 sym->name, &expr->where);
@@ -5124,7 +5124,7 @@ resolve_compcall (gfc_expr* e, bool fcn)
     return FAILURE;
 
   e->value.function.actual = newactual;
-  e->value.function.name = e->value.compcall.name;
+  e->value.function.name = NULL;
   e->value.function.esym = target->n.sym;
   e->value.function.class_esym = NULL;
   e->value.function.isym = NULL;
@@ -5178,18 +5178,17 @@ check_class_members (gfc_symbol *derived)
       return;
     }
 
-  if (tbp->n.tb->is_generic)
+  /* If we have to match a passed class member, force the actual
+      expression to have the correct type.  */
+  if (!tbp->n.tb->nopass)
     {
-      /* If we have to match a passed class member, force the actual
-	 expression to have the correct type.  */
-      if (!tbp->n.tb->nopass)
-	{
-	  if (e->value.compcall.base_object == NULL)
-	    e->value.compcall.base_object =
-			extract_compcall_passed_object (e);
+      if (e->value.compcall.base_object == NULL)
+	e->value.compcall.base_object = extract_compcall_passed_object (e);
 
-          e->value.compcall.base_object->ts.type = BT_DERIVED;
-          e->value.compcall.base_object->ts.u.derived = derived;
+      if (!derived->attr.abstract)
+	{
+	  e->value.compcall.base_object->ts.type = BT_DERIVED;
+	  e->value.compcall.base_object->ts.u.derived = derived;
 	}
     }
 

Attachment: typebound_call_13.f03
Description: Binary data


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]