[PATCH, Fortran] preparing procedure pointers

["Janus Weil" <jaydub66 at googlemail dot com>]

Hi all,
when I implemented PROCEDURE statements last year, I introduced a new
field named "interface" into "gfc_symbol", which should point to the
symbol which a PROCEDURE gets its interface from. Back then I wasn't
quite sure whether to put this new field into "gfc_symbol" or
"gfc_typespec", and decided somehow to put it into "gfc_symbol" (see
http://gcc.gnu.org/ml/fortran/2007-08/msg00357.html and follow-ups).
Actually now I think that this was a mistake, and it would have been
better to put it into "gfc_typespec". One reason for this is that one
would also like to use this same field for type-bound procedures,
which is not possible if it sits in "gfc_symbol", since type-bound
procedures are "components" of a derived type/class and would be
represented by "gfc_component". Moreover there are no really
convincing reasons that this field should be in "gfc_symbol". And in
g95, which has procedure pointers already implemented, this field is
also in the typespec.
Does everyone agree with me in this argumentation? Or are there any
other arguments against it? If not, I think we should change this
before starting to implement procedure pointers etc. The attached
patch does just that. It is rather mechanical and doesn't produce any
regressions in the gfortran testsuite on i686-pc-linux-gnu. Ok for
trunk?
Janus

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 133905)
+++ gcc/fortran/interface.c	(working copy)
@@ -2405,13 +2405,13 @@
     gfc_warning ("Procedure '%s' called with an implicit interface at %L",
 		 sym->name, where);
 
-  if (sym->interface && sym->interface->attr.intrinsic)
+  if (sym->ts.interface && sym->ts.interface->attr.intrinsic)
     {
       gfc_intrinsic_sym *isym;
-      isym = gfc_find_function (sym->interface->name);
+      isym = gfc_find_function (sym->ts.interface->name);
       if (isym != NULL)
 	{
-	  if (compare_actual_formal_intr (ap, sym->interface))
+	  if (compare_actual_formal_intr (ap, sym->ts.interface))
 	    return;
 	  gfc_error ("Type/rank mismatch in argument '%s' at %L",
 		     sym->name, where);
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 133905)
+++ gcc/fortran/decl.c	(working copy)
@@ -4060,8 +4060,8 @@
       /* Resolve interface if possible. That way, attr.procedure is only set
 	 if it is declared by a later procedure-declaration-stmt, which is
 	 invalid per C1212.  */
-      while (proc_if->interface)
-	proc_if = proc_if->interface;
+      while (proc_if->ts.interface)
+	proc_if = proc_if->ts.interface;
 
       if (proc_if->generic)
 	{
@@ -4147,16 +4147,16 @@
       /* Set interface.  */
       if (proc_if != NULL)
 	{
-	  sym->interface = proc_if;
+	  sym->ts.interface = proc_if;
 	  sym->attr.untyped = 1;
 	}
       else if (current_ts.type != BT_UNKNOWN)
 	{
-	  sym->interface = gfc_new_symbol ("", gfc_current_ns);
-	  sym->interface->ts = current_ts;
-	  sym->interface->attr.function = 1;
-	  sym->ts = sym->interface->ts;
-	  sym->attr.function = sym->interface->attr.function;
+	  sym->ts = current_ts;
+	  sym->ts.interface = gfc_new_symbol ("", gfc_current_ns);
+	  sym->ts.interface->ts = current_ts;
+	  sym->ts.interface->attr.function = 1;
+	  sym->attr.function = sym->ts.interface->attr.function;
 	}
 
       if (gfc_match_eos () == MATCH_YES)
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 133905)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -777,6 +777,7 @@
   int kind;
   struct gfc_symbol *derived;
   gfc_charlen *cl;	/* For character types only.  */
+  struct gfc_symbol *interface;	/* For PROCEDURE declarations.  */
   int is_c_interop;
   int is_iso_c;
   bt f90_type; 
@@ -995,8 +996,6 @@
   struct gfc_symbol *result;	/* function result symbol */
   gfc_component *components;	/* Derived type components */
 
-  struct gfc_symbol *interface;	/* For PROCEDURE declarations.  */
-
   /* Defined only for Cray pointees; points to their pointer.  */
   struct gfc_symbol *cp_pointer;
 
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 133905)
+++ gcc/fortran/resolve.c	(working copy)
@@ -1563,10 +1563,10 @@
 
   /* See if we have an intrinsic interface.  */
 
-  if (sym->interface != NULL && sym->interface->attr.intrinsic)
+  if (sym->ts.interface != NULL && sym->ts.interface->attr.intrinsic)
     {
       gfc_intrinsic_sym *isym;
-      isym = gfc_find_function (sym->interface->name);
+      isym = gfc_find_function (sym->ts.interface->name);
 
       /* Existance of isym should be checked already.  */
       gcc_assert (isym);
@@ -2636,12 +2636,12 @@
   match m;
 
   /* See if we have an intrinsic interface.  */
-  if (sym->interface != NULL && !sym->interface->attr.abstract
-      && !sym->interface->attr.subroutine)
+  if (sym->ts.interface != NULL && !sym->ts.interface->attr.abstract
+      && !sym->ts.interface->attr.subroutine)
     {
       gfc_intrinsic_sym *isym;
 
-      isym = gfc_find_function (sym->interface->name);
+      isym = gfc_find_function (sym->ts.interface->name);
 
       /* Existance of isym should be checked already.  */
       gcc_assert (isym);
@@ -7725,26 +7725,27 @@
 	}
     }
 
-  if (sym->attr.procedure && sym->interface
+  if (sym->attr.procedure && sym->ts.interface
       && sym->attr.if_source != IFSRC_DECL)
     {
-      if (sym->interface->attr.procedure)
+      if (sym->ts.interface->attr.procedure)
 	gfc_error ("Interface '%s', used by procedure '%s' at %L, is declared "
-		   "in a later PROCEDURE statement", sym->interface->name,
+		   "in a later PROCEDURE statement", sym->ts.interface->name,
 		   sym->name,&sym->declared_at);
 
       /* Get the attributes from the interface (now resolved).  */
-      if (sym->interface->attr.if_source || sym->interface->attr.intrinsic)
+      if (sym->ts.interface->attr.if_source || sym->ts.interface->attr.intrinsic)
 	{
-	  sym->ts = sym->interface->ts;
-	  sym->attr.function = sym->interface->attr.function;
-	  sym->attr.subroutine = sym->interface->attr.subroutine;
-	  copy_formal_args (sym, sym->interface);
+	  sym->ts.type = sym->ts.interface->ts.type;
+	  sym->ts.kind = sym->ts.interface->ts.kind;
+	  sym->attr.function = sym->ts.interface->attr.function;
+	  sym->attr.subroutine = sym->ts.interface->attr.subroutine;
+	  copy_formal_args (sym, sym->ts.interface);
 	}
-      else if (sym->interface->name[0] != '\0')
+      else if (sym->ts.interface->name[0] != '\0')
 	{
 	  gfc_error ("Interface '%s' of procedure '%s' at %L must be explicit",
-		    sym->interface->name, sym->name, &sym->declared_at);
+		    sym->ts.interface->name, sym->name, &sym->declared_at);
 	  return;
 	}
     }