re PR fortran/39630 ([F03] Procedure Pointer Components)

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

	PR fortran/39630
	* decl.c (match_ppc_decl): Implement the PASS attribute for procedure
	pointer components.
	(match_binding_attributes): Ditto.
	* gfortran.h (gfc_component): Add member 'tb'.
	(gfc_typebound_proc): Add member 'ppc' and make 'pass_arg' const.
	* module.c (MOD_VERSION): Bump module version.
	(binding_ppc): New string constants.
	(mio_component): Only use formal args if component is a procedure
	pointer and add 'tb' member.
	(mio_typebound_proc): Include pass_arg and take care of procedure
	pointer components.
	* resolve.c (update_arglist_pass): Add argument 'name' and take care of
	optional arguments.
	(extract_ppc_passed_object): New function, analogous to
	extract_compcall_passed_object, but for procedure pointer components.
	(update_ppc_arglist): New function, analogous to
	update_compcall_arglist, but for procedure pointer components.
	(resolve_typebound_generic_call): Added argument to update_arglist_pass.
	(resolve_ppc_call, resolve_expr_ppc): Take care of PASS attribute.
	(resolve_fl_derived): Check the PASS argument for procedure pointer
	components.
	* symbol.c (verify_bind_c_derived_type): Reject procedure pointer
	components in BIND(C) types.

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

	PR fortran/39630
	* gfortran.dg/proc_ptr_comp_3.f90: Modified.
	* gfortran.dg/proc_ptr_comp_pass_1.f90: New.
	* gfortran.dg/proc_ptr_comp_pass_2.f90: New.
	* gfortran.dg/proc_ptr_comp_pass_3.f90: New.
	* gfortran.dg/proc_ptr_comp_pass_4.f90: New.
	* gfortran.dg/proc_ptr_comp_pass_5.f90: New.
	* gfortran.dg/typebound_call_10.f03: New.

From-SVN: r150078

1 files changed, 33 insertions, 23 deletions

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 425bd36..eff482c 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -77,7 +77,7 @@ along with GCC; see the file COPYING3.  If not see
 
 /* Don't put any single quote (') in MOD_VERSION, 
    if yout want it to be recognized.  */
-#define MOD_VERSION "1"
+#define MOD_VERSION "2"
 
 
 /* Structure that describes a position within a module file.  */
@@ -1719,7 +1719,12 @@ static const mstring binding_generic[] =
     minit ("GENERIC", 1),
     minit (NULL, -1)
 };
-
+static const mstring binding_ppc[] =
+{
+    minit ("NO_PPC", 0),
+    minit ("PPC", 1),
+    minit (NULL, -1)
+};
 
 /* Specialization of mio_name.  */
 DECL_MIO_NAME (ab_attribute)
@@ -2260,7 +2265,7 @@ mio_component_ref (gfc_component **cp, gfc_symbol *sym)
 
 static void mio_namespace_ref (gfc_namespace **nsp);
 static void mio_formal_arglist (gfc_formal_arglist **formal);
-
+static void mio_typebound_proc (gfc_typebound_proc** proc);
 
 static void
 mio_component (gfc_component *c)
@@ -2295,28 +2300,33 @@ mio_component (gfc_component *c)
 
   mio_expr (&c->initializer);
 
-  if (iomode == IO_OUTPUT)
+  if (c->attr.proc_pointer)
     {
-      formal = c->formal;
-      while (formal && !formal->sym)
-	formal = formal->next;
+      if (iomode == IO_OUTPUT)
+	{
+	  formal = c->formal;
+	  while (formal && !formal->sym)
+	    formal = formal->next;
 
-      if (formal)
-	mio_namespace_ref (&formal->sym->ns);
+	  if (formal)
+	    mio_namespace_ref (&formal->sym->ns);
+	  else
+	    mio_namespace_ref (&c->formal_ns);
+	}
       else
-	mio_namespace_ref (&c->formal_ns);
-    }
-  else
-    {
-      mio_namespace_ref (&c->formal_ns);
-      /* TODO: if (c->formal_ns)
 	{
-	  c->formal_ns->proc_name = c;
-	  c->refs++;
-	}*/
-    }
+	  mio_namespace_ref (&c->formal_ns);
+	  /* TODO: if (c->formal_ns)
+	    {
+	      c->formal_ns->proc_name = c;
+	      c->refs++;
+	    }*/
+	}
+
+      mio_formal_arglist (&c->formal);
 
-  mio_formal_arglist (&c->formal);
+      mio_typebound_proc (&c->tb);
+    }
 
   mio_rparen ();
 }
@@ -3265,9 +3275,9 @@ mio_typebound_proc (gfc_typebound_proc** proc)
 
   (*proc)->nopass = mio_name ((*proc)->nopass, binding_passing);
   (*proc)->is_generic = mio_name ((*proc)->is_generic, binding_generic);
+  (*proc)->ppc = mio_name((*proc)->ppc, binding_ppc);
 
-  if (iomode == IO_INPUT)
-    (*proc)->pass_arg = NULL;
+  mio_pool_string (&((*proc)->pass_arg));
 
   flag = (int) (*proc)->pass_arg_num;
   mio_integer (&flag);
@@ -3304,7 +3314,7 @@ mio_typebound_proc (gfc_typebound_proc** proc)
 
       mio_rparen ();
     }
-  else
+  else if (!(*proc)->ppc)
     mio_symtree_ref (&(*proc)->u.specific);
 
   mio_rparen ();