re PR other/38920 (dw2 exceptions don't work.)

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

	PR fortran/38920
	* expr.c (gfc_check_pointer_assign): Enable interface check for
	procedure pointers.
	* gfortran.h: Add copy_formal_args_intr.
	* interface.c (gfc_compare_interfaces): Call gfc_compare_intr_interfaces
	if second argument is an intrinsic.
	(compare_intr_interfaces): Correctly set attr.function, attr.subroutine
	and ts.
	(compare_parameter): Call gfc_compare_interfaces also for intrinsics.
	* resolve.c (resolve_specific_f0,resolve_specific_s0): Don't resolve
	intrinsic interfaces here. Must happen earlier.
	(resolve_symbol): Resolution of intrinsic interfaces moved here from
	resolve_specific_..., and formal args are now copied from intrinsic
	interfaces.
	* symbol.c (copy_formal_args_intr): New function to copy the formal
	arguments from an intinsic procedure.


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

	PR fortran/38920
	* gfortran.dg/proc_decl_1.f90: Modified.
	* gfortran.dg/proc_ptr_11.f90: Extended.
	* gfortran.dg/proc_ptr_13.f90: Modified.

From-SVN: r145651

1 files changed, 53 insertions, 0 deletions

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 7414616..6ffd869 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3839,6 +3839,59 @@ copy_formal_args (gfc_symbol *dest, gfc_symbol *src)
   gfc_current_ns = parent_ns;
 }
 
+void
+copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src)
+{
+  gfc_formal_arglist *head = NULL;
+  gfc_formal_arglist *tail = NULL;
+  gfc_formal_arglist *formal_arg = NULL;
+  gfc_intrinsic_arg *curr_arg = NULL;
+  gfc_formal_arglist *formal_prev = NULL;
+  /* Save current namespace so we can change it for formal args.  */
+  gfc_namespace *parent_ns = gfc_current_ns;
+
+  /* Create a new namespace, which will be the formal ns (namespace
+     of the formal args).  */
+  gfc_current_ns = gfc_get_namespace (parent_ns, 0);
+  gfc_current_ns->proc_name = dest;
+
+  for (curr_arg = src->formal; curr_arg; curr_arg = curr_arg->next)
+    {
+      formal_arg = gfc_get_formal_arglist ();
+      gfc_get_symbol (curr_arg->name, gfc_current_ns, &(formal_arg->sym));
+
+      /* May need to copy more info for the symbol.  */
+      formal_arg->sym->ts = curr_arg->ts;
+      formal_arg->sym->attr.optional = curr_arg->optional;
+      /*formal_arg->sym->attr = curr_arg->sym->attr;
+      formal_arg->sym->as = gfc_copy_array_spec (curr_arg->sym->as);
+      copy_formal_args (formal_arg->sym, curr_arg->sym);*/
+
+      /* If this isn't the first arg, set up the next ptr.  For the
+        last arg built, the formal_arg->next will never get set to
+        anything other than NULL.  */
+      if (formal_prev != NULL)
+	formal_prev->next = formal_arg;
+      else
+	formal_arg->next = NULL;
+
+      formal_prev = formal_arg;
+
+      /* Add arg to list of formal args.  */
+      add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
+    }
+
+  /* Add the interface to the symbol.  */
+  add_proc_interface (dest, IFSRC_DECL, head);
+
+  /* Store the formal namespace information.  */
+  if (dest->formal != NULL)
+    /* The current ns should be that for the dest proc.  */
+    dest->formal_ns = gfc_current_ns;
+  /* Restore the current namespace to what it was on entry.  */
+  gfc_current_ns = parent_ns;
+}
+
 /* Builds the parameter list for the iso_c_binding procedure
    c_f_pointer or c_f_procpointer.  The old_sym typically refers to a
    generic version of either the c_f_pointer or c_f_procpointer