From 3afadac3ca557d83ad115178a631aeb60659b0c5 Mon Sep 17 00:00:00 2001
From: Janus Weil <janus@gcc.gnu.org>
Date: Tue, 7 Apr 2009 09:24:37 +0200
Subject: 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
---
 gcc/fortran/resolve.c | 67 +++++++++++++++++++++------------------------------
 1 file changed, 27 insertions(+), 40 deletions(-)

(limited to 'gcc/fortran/resolve.c')

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 32b13e4..1b866d9 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1742,23 +1742,6 @@ resolve_specific_f0 (gfc_symbol *sym, gfc_expr *expr)
 {
   match m;
 
-  /* See if we have an intrinsic interface.  */
-
-  if (sym->ts.interface != NULL && sym->ts.interface->attr.intrinsic)
-    {
-      gfc_intrinsic_sym *isym;
-      isym = gfc_find_function (sym->ts.interface->name);
-
-      /* Existence of isym should be checked already.  */
-      gcc_assert (isym);
-
-      sym->ts.type = isym->ts.type;
-      sym->ts.kind = isym->ts.kind;
-      sym->attr.function = 1;
-      sym->attr.proc = PROC_EXTERNAL;
-      goto found;
-    }
-
   if (sym->attr.external || sym->attr.if_source == IFSRC_IFBODY)
     {
       if (sym->attr.dummy)
@@ -2795,24 +2778,6 @@ resolve_specific_s0 (gfc_code *c, gfc_symbol *sym)
 {
   match m;
 
-  /* See if we have an intrinsic interface.  */
-  if (sym->ts.interface != NULL && !sym->ts.interface->attr.abstract
-      && !sym->ts.interface->attr.subroutine
-      && sym->ts.interface->attr.intrinsic)
-    {
-      gfc_intrinsic_sym *isym;
-
-      isym = gfc_find_function (sym->ts.interface->name);
-
-      /* Existence of isym should be checked already.  */
-      gcc_assert (isym);
-
-      sym->ts.type = isym->ts.type;
-      sym->ts.kind = isym->ts.kind;
-      sym->attr.subroutine = 1;
-      goto found;
-    }
-
   if(sym->attr.is_iso_c)
     {
       m = gfc_iso_c_sub_interface (c,sym);
@@ -9201,10 +9166,33 @@ resolve_symbol (gfc_symbol *sym)
       if (sym->ts.interface->attr.if_source || sym->ts.interface->attr.intrinsic)
 	{
 	  gfc_symbol *ifc = sym->ts.interface;
-	  sym->ts = ifc->ts;
-	  sym->ts.interface = ifc;
-	  sym->attr.function = ifc->attr.function;
-	  sym->attr.subroutine = ifc->attr.subroutine;
+
+	  if (ifc->attr.intrinsic)
+	    {
+	      gfc_intrinsic_sym *isym = gfc_find_function (sym->ts.interface->name);
+	      if (isym)
+		{
+		  sym->attr.function = 1;
+		  sym->ts = isym->ts;
+		  sym->ts.interface = ifc;
+		}
+	      else
+		{
+		  isym = gfc_find_subroutine (sym->ts.interface->name);
+		  gcc_assert (isym);
+		  sym->attr.subroutine = 1;
+		}
+	      copy_formal_args_intr (sym, isym);
+	    }
+	  else
+	    {
+	      sym->ts = ifc->ts;
+	      sym->ts.interface = ifc;
+	      sym->attr.function = ifc->attr.function;
+	      sym->attr.subroutine = ifc->attr.subroutine;
+	      copy_formal_args (sym, ifc);
+	    }
+
 	  sym->attr.allocatable = ifc->attr.allocatable;
 	  sym->attr.pointer = ifc->attr.pointer;
 	  sym->attr.pure = ifc->attr.pure;
@@ -9212,7 +9200,6 @@ resolve_symbol (gfc_symbol *sym)
 	  sym->attr.dimension = ifc->attr.dimension;
 	  sym->attr.recursive = ifc->attr.recursive;
 	  sym->attr.always_explicit = ifc->attr.always_explicit;
-	  copy_formal_args (sym, ifc);
 	  /* Copy array spec.  */
 	  sym->as = gfc_copy_array_spec (ifc->as);
 	  if (sym->as)
-- 
cgit v1.1