[Patch, Fortran, F03] PR 40869: PPC assignment checking

[Janus Weil <janus at gcc dot gnu dot org>]

Hi all,

here is another patch concerning procedure pointer components
(hopefully one of the last). It fixes the last TODO item which was
left over from my initial PPC patch in May: Implementing interface
checking for pointer assignments involving PPCs.

For plain procedure pointers this interface check is done via
'gfc_compare_interfaces', which is also used for comparing procedures
as actual/formal arguments.

The only obstacle for PPCs is that gfc_compare_interfaces can only
operate on gfc_symbols and not on gfc_components. This type of problem
has appeared in other places before, since many gfc_... functions
acting on procedures traditionally assume that these are simple
gfc_symbols. In some of the cases this problem was solved by simply
duplicating the function, where the second version would act on a
gfc_component instead of a gfc_symbol (which in a way is not nice, but
practical for small functions). In other cases (e.g. large functions
like gfc_conv_procedure_call), it seemed more viable to add an
additional gfc_expr attribute (representing the PPC), which would be
used instead of the gfc_symbol which is usually passed.

In the case at hand (i.e. gfc_compare_interfaces), we have a function
comparing two procedures, where each of these procedures may be either
a 'plain' procedure (pointer), represented by a gfc_symbol, or a PPC,
represented by a gfc_component. Having four instances of this
function, each handling one of the four combinations didn't seem like
the most elegant solution to me. Also adding two additional arguments
would clutter things up a lot, especially since the function already
has six arguments.

So, what I did in this case was to simplify the problem by using not
the component itself for the comparison, but instead the symbol which
it gets its interface from (ts.interface). Since this is a normal
gfc_symbol, it can be passed to the existing gfc_compare_interfaces
without any problem. One drawback of this method is that the error
messages contain the wrong name, or an empty name (if the PPC was
declared like e.g. "procedure(real), pointer ..."). So far this is the
only drawback I see. And this method is a lot more elegant than any of
the other solutions I could think of.

If anyone has a better solution, I'd be glad to hear it.

[If we had gcc-in-cxx, I guess we could make gfc_component the base
class for gfc_symbol, and have functions which accept any of the two,
acting only on their common fields like ts, attr, name etc. Well,
nevermind ...]

The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?

Cheers,
Janus


2009-08-25  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40869
	* expr.c (gfc_check_pointer_assign): Enable interface check for
	pointer assignments involving procedure pointer components.
	* interface.c (gfc_compare_interfaces): Don't rely on the proc_pointer
	attribute, but instead on the flags handed to this function.

2009-08-25  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40869
	* gfortran.dg/proc_ptr_comp_20.f90: New.

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 151080)
+++ gcc/fortran/interface.c	(working copy)
@@ -966,8 +966,7 @@ gfc_compare_interfaces (gfc_symbol *s1, 
 
   /* If the arguments are functions, check type and kind
      (only for dummy procedures and procedure pointer assignments).  */
-  if ((s1->attr.dummy || s1->attr.proc_pointer)
-      && s1->attr.function && s2->attr.function)
+  if (!generic_flag && intent_flag && s1->attr.function && s2->attr.function)
     {
       if (s1->ts.type == BT_UNKNOWN)
 	return 1;
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(revision 151080)
+++ gcc/fortran/expr.c	(working copy)
@@ -3149,6 +3149,9 @@ gfc_check_pointer_assign (gfc_expr *lval
   if (proc_pointer)
     {
       char err[200];
+      gfc_symbol *s1,*s2;
+      gfc_component *comp;
+
       attr = gfc_expr_attr (rvalue);
       if (!((rvalue->expr_type == EXPR_NULL)
 	    || (rvalue->expr_type == EXPR_FUNCTION && attr.proc_pointer)
@@ -3208,22 +3211,25 @@ gfc_check_pointer_assign (gfc_expr *lval
 	    }
 	}
 
-      /* TODO: Enable interface check for PPCs.  */
-      if (gfc_is_proc_ptr_comp (rvalue, NULL))
-	return SUCCESS;
-      if ((rvalue->expr_type == EXPR_VARIABLE
-	   && !gfc_compare_interfaces (lvalue->symtree->n.sym,
-				       rvalue->symtree->n.sym, 0, 1, err,
-				       sizeof(err)))
-	  || (rvalue->expr_type == EXPR_FUNCTION
-	      && !gfc_compare_interfaces (lvalue->symtree->n.sym,
-					  rvalue->symtree->n.sym->result, 0, 1,
-					  err, sizeof(err))))
+      if (gfc_is_proc_ptr_comp (lvalue, &comp))
+	s1 = comp->ts.interface;
+      else
+	s1 = lvalue->symtree->n.sym;
+
+      if (gfc_is_proc_ptr_comp (rvalue, &comp))
+	s2 = comp->ts.interface;
+      else if (rvalue->expr_type == EXPR_FUNCTION)
+	s2 = rvalue->symtree->n.sym->result;
+      else
+	s2 = rvalue->symtree->n.sym;
+
+      if (s1 && s2 && !gfc_compare_interfaces (s1, s2, 0, 1, err, sizeof(err)))
 	{
 	  gfc_error ("Interface mismatch in procedure pointer assignment "
 		     "at %L: %s", &rvalue->where, err);
 	  return FAILURE;
 	}
+
       return SUCCESS;
     }

Attachment: proc_ptr_comp_20.f90
Description: Binary data