Re: [Patch, Fortran] PR 39735: procedure pointer assignments: return value is not checked

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

Hi Tobi,

>> here is my patch for PR 39735, which has become a bit larger than
>> expected. Its primary purpose is to add a check for procedure pointer
>> assignments, which makes sure that the assigned procedure has the
>> right return type. Other checks have already been added with PR 38290
>> (cf. proc_ptr_11.f90).
>
> Can you rename
> ?copy_formal_args
> to
> ?gfc_copy_formal_args
> as it is not static/restricted to one file.

Sure. Updated patch attached.


> Additionally, I have the feeling that gfortran will leak memory if
> resolve_intrinsic is called multiple times for the same proc pointer
> due to gfc_copy_formal_args not freeing the memory, but I might have
> overlooked something.

Well, good point. I admit, I haven't checked if and under which
circumstances it will be called more than once, but this surely might
happen. I modified resolve_intrinsic to only call
gfc_copy_formal_args_intr if the formal arg list is not present yet.
This should prevent any memory leaks.

Thanks for the comments.

Cheers,
Janus

Index: gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90	(Revision 146272)
+++ gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90	(Arbeitskopie)
@@ -8,6 +8,7 @@ module mo
 contains
 
   function j()
+    implicit none
     procedure(),pointer :: j
     intrinsic iabs
     j => iabs
Index: gcc/testsuite/gfortran.dg/interface_26.f90
===================================================================
--- gcc/testsuite/gfortran.dg/interface_26.f90	(Revision 146272)
+++ gcc/testsuite/gfortran.dg/interface_26.f90	(Arbeitskopie)
@@ -37,7 +37,7 @@ CONTAINS
     END INTERFACE
     INTEGER, EXTERNAL :: UserOp 
 
-    res = UserFunction( a,b, UserOp )
+    res = UserFunction( a,b, UserOp ) ! { dg-error "Type/rank mismatch in argument" }
 
     if( res .lt. 10 ) then
        res = recSum( a, res, UserFunction, UserOp ) 
Index: gcc/testsuite/gfortran.dg/external_initializer.f90
===================================================================
--- gcc/testsuite/gfortran.dg/external_initializer.f90	(Revision 146272)
+++ gcc/testsuite/gfortran.dg/external_initializer.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
 ! PR20849 - An external symbol may not have a initializer.
 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
-REAL, EXTERNAL :: X=0 ! { dg-error "may not have an initializer" }
+REAL, EXTERNAL :: X=0 ! { dg-error "not have an initializer" }
 END
Index: gcc/testsuite/gfortran.dg/assumed_charlen_function_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/assumed_charlen_function_5.f90	(Revision 146272)
+++ gcc/testsuite/gfortran.dg/assumed_charlen_function_5.f90	(Arbeitskopie)
@@ -12,7 +12,7 @@ end function charrext
 
   character(26), external :: charrext
   interface
-    integer(4) function test(charr, i)
+    integer(4) function test(charr, i)  ! { dg-warning "is obsolescent in fortran 95" }
      character(*), external :: charr
      integer :: i
     end function test
@@ -36,4 +36,5 @@ integer(4) function test(charr, i)  ! { 
   integer :: i
   print *, charr(i)
   test = 1
-end function test
\ Kein Zeilenumbruch am Dateiende.
+end function test
+
Index: gcc/testsuite/gfortran.dg/intrinsic_subroutine.f90
===================================================================
--- gcc/testsuite/gfortran.dg/intrinsic_subroutine.f90	(Revision 146272)
+++ gcc/testsuite/gfortran.dg/intrinsic_subroutine.f90	(Arbeitskopie)
@@ -3,5 +3,5 @@
 implicit none
 intrinsic cpu_time
 real :: time
-print *, CPU_TIME(TIME)  ! { dg-error "Intrinsic subroutine" }
+print *, CPU_TIME(TIME)  ! { dg-error "attribute conflicts with" }
 end
Index: gcc/testsuite/gfortran.dg/proc_ptr_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_ptr_3.f90	(Revision 146272)
+++ gcc/testsuite/gfortran.dg/proc_ptr_3.f90	(Arbeitskopie)
@@ -27,7 +27,7 @@ interface
   end subroutine sp
 end interface
 
-external :: e1
+real, external :: e1
 
 interface
   subroutine e2(a,b)
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(Revision 146272)
+++ gcc/fortran/interface.c	(Arbeitskopie)
@@ -479,8 +479,6 @@ compare_type_rank (gfc_symbol *s1, gfc_s
 }
 
 
-static int compare_intr_interfaces (gfc_symbol *, gfc_symbol *);
-
 /* Given two symbols that are formal arguments, compare their types
    and rank and their formal interfaces if they are both dummy
    procedures.  Returns nonzero if the same, zero if different.  */
@@ -967,155 +965,44 @@ gfc_compare_interfaces (gfc_symbol *s1, 
 {
   gfc_formal_arglist *f1, *f2;
 
-  if (s2->attr.intrinsic)
-    return compare_intr_interfaces (s1, s2);
-
-  if (s1->attr.function != s2->attr.function
-      || s1->attr.subroutine != s2->attr.subroutine)
-    return 0;		/* Disagreement between function/subroutine.  */
-
-  f1 = s1->formal;
-  f2 = s2->formal;
-
-  if (f1 == NULL && f2 == NULL)
-    return 1;			/* Special case.  */
-
-  if (count_types_test (f1, f2))
-    return 0;
-  if (count_types_test (f2, f1))
+  if ((s1->attr.function && !s2->attr.function)
+      || (s1->attr.subroutine && s2->attr.function))
     return 0;
 
-  if (generic_flag)
+  /* 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_correspondence (f1, f2))
-	return 0;
-      if (generic_correspondence (f2, f1))
-	return 0;
-    }
-  else
-    {
-      if (operator_correspondence (f1, f2))
-	return 0;
-    }
-
-  return 1;
-}
-
-
-static int
-compare_intr_interfaces (gfc_symbol *s1, gfc_symbol *s2)
-{
-  gfc_formal_arglist *f, *f1;
-  gfc_intrinsic_arg *fi, *f2;
-  gfc_intrinsic_sym *isym;
-
-  isym = gfc_find_function (s2->name);
-  if (isym)
-    {
-      if (!s2->attr.function)
-	gfc_add_function (&s2->attr, s2->name, &gfc_current_locus);
-      s2->ts = isym->ts;
-    }
-  else
-    {
-      isym = gfc_find_subroutine (s2->name);
-      gcc_assert (isym);
-      if (!s2->attr.subroutine)
-	gfc_add_subroutine (&s2->attr, s2->name, &gfc_current_locus);
-    }
-
-  if (s1->attr.function != s2->attr.function
-      || s1->attr.subroutine != s2->attr.subroutine)
-    return 0;		/* Disagreement between function/subroutine.  */
-  
-  /* If the arguments are functions, check type and kind.  */
-  
-  if (s1->attr.dummy && s1->attr.function && s2->attr.function)
-    {
-      if (s1->ts.type != s2->ts.type)
-	return 0;
-      if (s1->ts.kind != s2->ts.kind)
+      if (s1->ts.type == BT_UNKNOWN)
+	return 1;
+      if ((s1->ts.type != s2->ts.type) || (s1->ts.kind != s2->ts.kind))
 	return 0;
       if (s1->attr.if_source == IFSRC_DECL)
 	return 1;
     }
 
-  f1 = s1->formal;
-  f2 = isym->formal;
-
-  /* Special case.  */
-  if (f1 == NULL && f2 == NULL)
+  if (s1->attr.if_source == IFSRC_UNKNOWN)
     return 1;
-  
-  /* First scan through the formal argument list and check the intrinsic.  */
-  fi = f2;
-  for (f = f1; f; f = f->next)
-    {
-      if (fi == NULL)
-	return 0;
-      if ((fi->ts.type != f->sym->ts.type) || (fi->ts.kind != f->sym->ts.kind))
-	return 0;
-      fi = fi->next;
-    }
 
-  /* Now scan through the intrinsic argument list and check the formal.  */
-  f = f1;
-  for (fi = f2; fi; fi = fi->next)
-    {
-      if (f == NULL)
-	return 0;
-      if ((fi->ts.type != f->sym->ts.type) || (fi->ts.kind != f->sym->ts.kind))
-	return 0;
-      f = f->next;
-    }
-
-  return 1;
-}
-
-
-/* Compare an actual argument list with an intrinsic argument list.  */
-
-static int
-compare_actual_formal_intr (gfc_actual_arglist **ap, gfc_symbol *s2)
-{
-  gfc_actual_arglist *a;
-  gfc_intrinsic_arg *fi, *f2;
-  gfc_intrinsic_sym *isym;
+  f1 = s1->formal;
+  f2 = s2->formal;
 
-  isym = gfc_find_function (s2->name);
-  
-  /* This should already have been checked in
-     resolve.c (resolve_actual_arglist).  */
-  gcc_assert (isym);
+  if (f1 == NULL && f2 == NULL)
+    return 1;			/* Special case.  */
 
-  f2 = isym->formal;
+  if (count_types_test (f1, f2) || count_types_test (f2, f1))
+    return 0;
 
-  /* Special case.  */
-  if (*ap == NULL && f2 == NULL)
-    return 1;
-  
-  /* First scan through the actual argument list and check the intrinsic.  */
-  fi = f2;
-  for (a = *ap; a; a = a->next)
+  if (generic_flag)
     {
-      if (fi == NULL)
+      if (generic_correspondence (f1, f2) || generic_correspondence (f2, f1))
 	return 0;
-      if ((fi->ts.type != a->expr->ts.type)
-	  || (fi->ts.kind != a->expr->ts.kind))
-	return 0;
-      fi = fi->next;
     }
-
-  /* Now scan through the intrinsic argument list and check the formal.  */
-  a = *ap;
-  for (fi = f2; fi; fi = fi->next)
+  else
     {
-      if (a == NULL)
-	return 0;
-      if ((fi->ts.type != a->expr->ts.type)
-	  || (fi->ts.kind != a->expr->ts.kind))
+      if (operator_correspondence (f1, f2))
 	return 0;
-      a = a->next;
     }
 
   return 1;
@@ -2436,20 +2323,6 @@ gfc_procedure_use (gfc_symbol *sym, gfc_
     gfc_warning ("Procedure '%s' called with an implicit interface at %L",
 		 sym->name, where);
 
-  if (sym->ts.interface && sym->ts.interface->attr.intrinsic)
-    {
-      gfc_intrinsic_sym *isym;
-      isym = gfc_find_function (sym->ts.interface->name);
-      if (isym != NULL)
-	{
-	  if (compare_actual_formal_intr (ap, sym->ts.interface))
-	    return;
-	  gfc_error ("Type/rank mismatch in argument '%s' at %L",
-		     sym->name, where);
-	  return;
-	}
-    }
-
   if (sym->attr.if_source == IFSRC_UNKNOWN)
     {
       gfc_actual_arglist *a;
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c	(Revision 146272)
+++ gcc/fortran/intrinsic.c	(Arbeitskopie)
@@ -1362,7 +1362,7 @@ add_functions (void)
 
   add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
 	     gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
-	     x, BT_REAL, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
+	     x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
 
   add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
 	     NULL, gfc_simplify_dim, gfc_resolve_dim,
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(Revision 146272)
+++ gcc/fortran/symbol.c	(Arbeitskopie)
@@ -75,8 +75,7 @@ const mstring ifsrc_types[] =
 {
     minit ("UNKNOWN", IFSRC_UNKNOWN),
     minit ("DECL", IFSRC_DECL),
-    minit ("BODY", IFSRC_IFBODY),
-    minit ("USAGE", IFSRC_USAGE)
+    minit ("BODY", IFSRC_IFBODY)
 };
 
 const mstring save_status[] =
@@ -3768,6 +3767,7 @@ gen_shape_param (gfc_formal_arglist **he
   add_formal_arg (head, tail, formal_arg, param_sym);
 }
 
+
 /* Add a procedure interface to the given symbol (i.e., store a
    reference to the list of formal arguments).  */
 
@@ -3780,6 +3780,7 @@ add_proc_interface (gfc_symbol *sym, ifs
   sym->attr.if_source = source;
 }
 
+
 /* Copy the formal args from an existing symbol, src, into a new
    symbol, dest.  New formal args are created, and the description of
    each arg is set according to the existing ones.  This function is
@@ -3788,7 +3789,7 @@ add_proc_interface (gfc_symbol *sym, ifs
    args based on the args of a given named interface.  */
 
 void
-copy_formal_args (gfc_symbol *dest, gfc_symbol *src)
+gfc_copy_formal_args (gfc_symbol *dest, gfc_symbol *src)
 {
   gfc_formal_arglist *head = NULL;
   gfc_formal_arglist *tail = NULL;
@@ -3812,7 +3813,7 @@ copy_formal_args (gfc_symbol *dest, gfc_
       formal_arg->sym->attr = curr_arg->sym->attr;
       formal_arg->sym->ts = curr_arg->sym->ts;
       formal_arg->sym->as = gfc_copy_array_spec (curr_arg->sym->as);
-      copy_formal_args (formal_arg->sym, curr_arg->sym);
+      gfc_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
@@ -3839,8 +3840,9 @@ copy_formal_args (gfc_symbol *dest, gfc_
   gfc_current_ns = parent_ns;
 }
 
+
 void
-copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src)
+gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src)
 {
   gfc_formal_arglist *head = NULL;
   gfc_formal_arglist *tail = NULL;
@@ -3863,9 +3865,6 @@ copy_formal_args_intr (gfc_symbol *dest,
       /* 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
@@ -3892,6 +3891,7 @@ copy_formal_args_intr (gfc_symbol *dest,
   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
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(Revision 146272)
+++ gcc/fortran/decl.c	(Arbeitskopie)
@@ -4104,9 +4104,14 @@ add_hidden_procptr_result (gfc_symbol *s
     {
       gfc_symtree *stree;
       if (case1)
-        gfc_get_sym_tree ("ppr@", gfc_current_ns, &stree);
+	gfc_get_sym_tree ("ppr@", gfc_current_ns, &stree);
       else if (case2)
-        gfc_get_sym_tree ("ppr@", gfc_current_ns->parent, &stree);
+	{
+	  gfc_symtree *st2;
+	  gfc_get_sym_tree ("ppr@", gfc_current_ns->parent, &stree);
+	  st2 = gfc_new_symtree (&gfc_current_ns->sym_root, "ppr@");
+	  st2->n.sym = stree->n.sym;
+	}
       sym->result = stree->n.sym;
 
       sym->result->attr.proc_pointer = sym->attr.proc_pointer;
@@ -4291,6 +4296,7 @@ got_ts:
 	    }
 	  sym->ts.interface = proc_if;
 	  sym->attr.untyped = 1;
+	  sym->attr.if_source = IFSRC_IFBODY;
 	}
       else if (current_ts.type != BT_UNKNOWN)
 	{
@@ -4300,6 +4306,7 @@ got_ts:
 	  sym->ts.interface->ts = current_ts;
 	  sym->ts.interface->attr.function = 1;
 	  sym->attr.function = sym->ts.interface->attr.function;
+	  sym->attr.if_source = IFSRC_UNKNOWN;
 	}
 
       if (gfc_match (" =>") == MATCH_YES)
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(Revision 146272)
+++ gcc/fortran/gfortran.h	(Arbeitskopie)
@@ -274,9 +274,12 @@ typedef enum gfc_access
 gfc_access;
 
 /* Flags to keep track of where an interface came from.
-   4 elements = 2 bits.  */
+   3 elements = 2 bits.  */
 typedef enum ifsrc
-{ IFSRC_UNKNOWN = 0, IFSRC_DECL, IFSRC_IFBODY, IFSRC_USAGE
+{ IFSRC_UNKNOWN = 0,	/* Interface unknown, only return type may be known.  */
+  IFSRC_DECL,		/* FUNCTION or SUBROUTINE declaration.  */
+  IFSRC_IFBODY		/* INTERFACE statement or PROCEDURE statement
+			   with explicit interface.  */
 }
 ifsrc;
 
@@ -2370,8 +2373,8 @@ gfc_gsymbol *gfc_find_gsymbol (gfc_gsymb
 gfc_symbol* gfc_get_derived_super_type (gfc_symbol*);
 gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*, const char*, bool);
 
-void copy_formal_args (gfc_symbol *, gfc_symbol *);
-void copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *);
+void gfc_copy_formal_args (gfc_symbol *, gfc_symbol *);
+void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *);
 
 void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too  */
 
Index: gcc/fortran/trans-const.c
===================================================================
--- gcc/fortran/trans-const.c	(Revision 146272)
+++ gcc/fortran/trans-const.c	(Arbeitskopie)
@@ -176,7 +176,7 @@ gfc_conv_string_init (tree length, gfc_e
 void
 gfc_conv_const_charlen (gfc_charlen * cl)
 {
-  if (cl->backend_decl)
+  if (!cl || cl->backend_decl)
     return;
 
   if (cl->length && cl->length->expr_type == EXPR_CONSTANT)
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(Revision 146272)
+++ gcc/fortran/expr.c	(Arbeitskopie)
@@ -3146,9 +3146,9 @@ gfc_check_pointer_assign (gfc_expr *lval
 	  gfc_error ("Abstract interface '%s' is invalid "
 		     "in procedure pointer assignment at %L",
 		     rvalue->symtree->name, &rvalue->where);
+	  return FAILURE;
 	}
       if (rvalue->expr_type == EXPR_VARIABLE
-	  && lvalue->symtree->n.sym->attr.if_source != IFSRC_UNKNOWN
 	  && !gfc_compare_interfaces (lvalue->symtree->n.sym,
 				      rvalue->symtree->n.sym, 0))
 	{
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 146272)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -1129,6 +1129,34 @@ is_illegal_recursion (gfc_symbol* sym, g
 }
 
 
+/* Resolve an intrinsic procedure: Set its function/subroutine attribute,
+   its typespec and formal argument list.  */
+
+static gfc_try
+resolve_intrinsic (gfc_symbol *sym, locus *loc)
+{
+  gfc_intrinsic_sym *isym = gfc_find_function (sym->name);
+  if (isym)
+    {
+      if (!sym->attr.function &&
+	  gfc_add_function (&sym->attr, sym->name, loc) == FAILURE)
+	return FAILURE;
+      sym->ts = isym->ts;
+    }
+  else
+    {
+      isym = gfc_find_subroutine (sym->name);
+      gcc_assert (isym);
+      if (!sym->attr.subroutine &&
+	  gfc_add_subroutine (&sym->attr, sym->name, loc) == FAILURE)
+	return FAILURE;
+    }
+  if (!sym->formal)
+    gfc_copy_formal_args_intr (sym, isym);
+  return SUCCESS;
+}
+
+
 /* Resolve a procedure expression, like passing it to a called procedure or as
    RHS for a procedure pointer assignment.  */
 
@@ -1142,6 +1170,10 @@ resolve_procedure_expression (gfc_expr* 
   gcc_assert (expr->symtree);
 
   sym = expr->symtree->n.sym;
+
+  if (sym->attr.intrinsic)
+    resolve_intrinsic (sym, &expr->where);
+
   if (sym->attr.flavor != FL_PROCEDURE
       || (sym->attr.function && sym->result == sym))
     return SUCCESS;
@@ -2306,14 +2338,8 @@ resolve_function (gfc_expr *expr)
     sym = expr->symtree->n.sym;
 
   if (sym && sym->attr.intrinsic
-      && !gfc_find_function (sym->name)
-      && gfc_find_subroutine (sym->name)
-      && sym->attr.function)
-    {
-      gfc_error ("Intrinsic subroutine '%s' used as "
-		  "a function at %L", sym->name, &expr->where);
-      return FAILURE;
-    }
+      && resolve_intrinsic (sym, &expr->where) == FAILURE)
+    return FAILURE;
 
   if (sym && (sym->attr.flavor == FL_VARIABLE || sym->attr.subroutine))
     {
@@ -9181,6 +9207,9 @@ resolve_symbol (gfc_symbol *sym)
 	}
     }
 
+  if (sym->attr.external && sym->ts.type != BT_UNKNOWN && !sym->attr.function)
+    gfc_add_function (&sym->attr, sym->name, &sym->declared_at);
+
   if (sym->attr.procedure && sym->ts.interface
       && sym->attr.if_source != IFSRC_DECL)
     {
@@ -9195,30 +9224,13 @@ resolve_symbol (gfc_symbol *sym)
 	  gfc_symbol *ifc = sym->ts.interface;
 
 	  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);
-	    }
+	    resolve_intrinsic (ifc, &ifc->declared_at);
+
+	  sym->ts = ifc->ts;
+	  sym->ts.interface = ifc;
+	  sym->attr.function = ifc->attr.function;
+	  sym->attr.subroutine = ifc->attr.subroutine;
+	  gfc_copy_formal_args (sym, ifc);
 
 	  sym->attr.allocatable = ifc->attr.allocatable;
 	  sym->attr.pointer = ifc->attr.pointer;