2009-06-22 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk r148777



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@148778 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 24 insertions, 6 deletions

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 4954389848b..53cc95fe76e 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -939,7 +939,9 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag,
 {
   gfc_formal_arglist *f1, *f2;
 
-  if (s1->attr.function && !s2->attr.function)
+  if (s1->attr.function && (s2->attr.subroutine
+      || (!s2->attr.function && s2->ts.type == BT_UNKNOWN
+	  && gfc_get_default_type (s2->name, s2->ns)->type == BT_UNKNOWN)))
     {
       if (errmsg != NULL)
 	snprintf (errmsg, err_len, "'%s' is not a function", s2->name);
@@ -967,8 +969,6 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag,
 		      "of '%s'", s2->name);
 	  return 0;
 	}
-      if (s1->attr.if_source == IFSRC_DECL)
-	return 1;
     }
 
   if (s1->attr.if_source == IFSRC_UNKNOWN
@@ -1388,6 +1388,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
   if (actual->ts.type == BT_PROCEDURE)
     {
       char err[200];
+      gfc_symbol *act_sym = actual->symtree->n.sym;
 
       if (formal->attr.flavor != FL_PROCEDURE)
 	{
@@ -1396,7 +1397,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 	  return 0;
 	}
 
-      if (!gfc_compare_interfaces (formal, actual->symtree->n.sym, 0, 1, err,
+      if (!gfc_compare_interfaces (formal, act_sym, 0, 1, err,
 				   sizeof(err)))
 	{
 	  if (where)
@@ -1405,6 +1406,13 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 	  return 0;
 	}
 
+      if (formal->attr.function && !act_sym->attr.function)
+	gfc_add_function (&act_sym->attr, act_sym->name, &act_sym->declared_at);
+
+      if (formal->attr.subroutine && !act_sym->attr.subroutine)
+	gfc_add_subroutine (&act_sym->attr, act_sym->name,
+			    &act_sym->declared_at);
+
       return 1;
     }
 
@@ -2417,6 +2425,7 @@ gfc_symbol *
 gfc_search_interface (gfc_interface *intr, int sub_flag,
 		      gfc_actual_arglist **ap)
 {
+  gfc_symbol *elem_sym = NULL;
   for (; intr; intr = intr->next)
     {
       if (sub_flag && intr->sym->attr.function)
@@ -2425,10 +2434,19 @@ gfc_search_interface (gfc_interface *intr, int sub_flag,
 	continue;
 
       if (gfc_arglist_matches_symbol (ap, intr->sym))
-	return intr->sym;
+	{
+	  /* Satisfy 12.4.4.1 such that an elemental match has lower
+	     weight than a non-elemental match.  */ 
+	  if (intr->sym->attr.elemental)
+	    {
+	      elem_sym = intr->sym;
+	      continue;
+	    }
+	  return intr->sym;
+	}
     }
 
-  return NULL;
+  return elem_sym ? elem_sym : NULL;
 }