2013-05-20 Tobias Burnus <burnus@net-b.de>

        PR fortran/48858
        PR fortran/55465
        * decl.c (add_global_entry): Add sym_name.
        * parse.c (add_global_procedure): Ditto.
        * resolve.c (resolve_bind_c_derived_types): Handle multiple decl for
        a procedure.
        (resolve_global_procedure): Handle gsym->ns pointing to a module.
        * trans-decl.c (gfc_get_extern_function_decl): Ditto.

2013-05-20  Tobias Burnus  <burnus@net-b.de>

        PR fortran/48858
        PR fortran/55465
        * gfortran.dg/binding_label_tests_10_main.f03: Update dg-error.
        * gfortran.dg/binding_label_tests_11_main.f03: Ditto.
        * gfortran.dg/binding_label_tests_13_main.f03: Ditto.
        * gfortran.dg/binding_label_tests_3.f03: Ditto.
        * gfortran.dg/binding_label_tests_4.f03: Ditto.
        * gfortran.dg/binding_label_tests_5.f03: Ditto.
        * gfortran.dg/binding_label_tests_6.f03: Ditto.
        * gfortran.dg/binding_label_tests_7.f03: Ditto.
        * gfortran.dg/binding_label_tests_8.f03: Ditto.
        * gfortran.dg/c_loc_tests_12.f03: Fix test case.
        * gfortran.dg/binding_label_tests_24.f90: New.
        * gfortran.dg/binding_label_tests_25.f90: New.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@199120 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 123 insertions, 79 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 08b4602dd86..7b48c4d3670 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,6 +1,17 @@
 2013-05-20  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/48858
+	PR fortran/55465
+	* decl.c (add_global_entry): Add sym_name.
+	* parse.c (add_global_procedure): Ditto.
+	* resolve.c (resolve_bind_c_derived_types): Handle multiple decl for
+	a procedure.
+	(resolve_global_procedure): Handle gsym->ns pointing to a module.
+	* trans-decl.c (gfc_get_extern_function_decl): Ditto.
+
+2013-05-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/48858
 	* decl.c (add_global_entry): Use nonbinding name
 	only for F2003 or if no binding label exists.
 	(gfc_match_entry): Update calls.
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index cb449a2f7a6..6ab9cc78438 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -5375,6 +5375,7 @@ add_global_entry (const char *name, const char *binding_label, bool sub)
       else
 	{
 	  s->type = type;
+	  s->sym_name = name;
 	  s->where = gfc_current_locus;
 	  s->defined = 1;
 	  s->ns = gfc_current_ns;
@@ -5396,6 +5397,7 @@ add_global_entry (const char *name, const char *binding_label, bool sub)
       else
 	{
 	  s->type = type;
+	  s->sym_name = name;
 	  s->binding_label = binding_label;
 	  s->where = gfc_current_locus;
 	  s->defined = 1;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index ba1730a8f18..a223a2cb704 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -4359,10 +4359,15 @@ add_global_procedure (bool sub)
       if (s->defined
 	  || (s->type != GSYM_UNKNOWN
 	      && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION)))
-	gfc_global_used(s, NULL);
+	{
+	  gfc_global_used (s, NULL);
+	  /* Silence follow-up errors.  */
+	  gfc_new_block->binding_label = NULL;
+	}
       else
 	{
 	  s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
+	  s->sym_name = gfc_new_block->name;
 	  s->where = gfc_current_locus;
 	  s->defined = 1;
 	  s->ns = gfc_current_ns;
@@ -4379,10 +4384,15 @@ add_global_procedure (bool sub)
       if (s->defined
 	  || (s->type != GSYM_UNKNOWN
 	      && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION)))
-	gfc_global_used(s, NULL);
+	{
+	  gfc_global_used (s, NULL);
+	  /* Silence follow-up errors.  */
+	  gfc_new_block->binding_label = NULL;
+	}
       else
 	{
 	  s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
+	  s->sym_name = gfc_new_block->name;
 	  s->binding_label = gfc_new_block->binding_label;
 	  s->where = gfc_current_locus;
 	  s->defined = 1;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f3607b41774..74e0aa4b432 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2389,6 +2389,11 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
 	}
 
       def_sym = gsym->ns->proc_name;
+
+      /* This can happen if a binding name has been specified.  */
+      if (gsym->binding_label && gsym->sym_name != def_sym->name)
+	gfc_find_symbol (gsym->sym_name, gsym->ns, 0, &def_sym);
+
       if (def_sym->attr.entry_master)
 	{
 	  gfc_entry_list *entry;
@@ -10023,90 +10028,91 @@ resolve_bind_c_derived_types (gfc_symbol *derived_sym)
 
 
 /* Verify that any binding labels used in a given namespace do not collide
-   with the names or binding labels of any global symbols.  */
+   with the names or binding labels of any global symbols.  Multiple INTERFACE
+   for the same procedure are permitted.  */
 
 static void
 gfc_verify_binding_labels (gfc_symbol *sym)
 {
-  int has_error = 0;
+  gfc_gsymbol *gsym;
+  const char *module;
 
-  if (sym != NULL && sym->attr.is_bind_c && sym->attr.is_iso_c == 0
-      && sym->attr.flavor != FL_DERIVED && sym->binding_label)
-    {
-      gfc_gsymbol *bind_c_sym;
+  if (!sym || !sym->attr.is_bind_c || sym->attr.is_iso_c
+      || sym->attr.flavor == FL_DERIVED || !sym->binding_label)
+    return;
 
-      bind_c_sym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label);
-      if (bind_c_sym != NULL
-          && strcmp (bind_c_sym->name, sym->binding_label) == 0)
-        {
-          if (sym->attr.if_source == IFSRC_DECL
-              && (bind_c_sym->type != GSYM_SUBROUTINE
-                  && bind_c_sym->type != GSYM_FUNCTION)
-              && ((sym->attr.contained == 1
-                   && strcmp (bind_c_sym->sym_name, sym->name) != 0)
-                  || (sym->attr.use_assoc == 1
-                      && (strcmp (bind_c_sym->mod_name, sym->module) != 0))))
-            {
-              /* Make sure global procedures don't collide with anything.  */
-              gfc_error ("Binding label '%s' at %L collides with the global "
-                         "entity '%s' at %L", sym->binding_label,
-                         &(sym->declared_at), bind_c_sym->name,
-                         &(bind_c_sym->where));
-              has_error = 1;
-            }
-          else if (sym->attr.contained == 0
-                   && (sym->attr.if_source == IFSRC_IFBODY
-                       && sym->attr.flavor == FL_PROCEDURE)
-                   && (bind_c_sym->sym_name != NULL
-                       && strcmp (bind_c_sym->sym_name, sym->name) != 0))
-            {
-              /* Make sure procedures in interface bodies don't collide.  */
-              gfc_error ("Binding label '%s' in interface body at %L collides "
-                         "with the global entity '%s' at %L",
-                         sym->binding_label,
-                         &(sym->declared_at), bind_c_sym->name,
-                         &(bind_c_sym->where));
-              has_error = 1;
-            }
-          else if (sym->attr.contained == 0
-                   && sym->attr.if_source == IFSRC_UNKNOWN)
-	    if ((sym->attr.use_assoc && bind_c_sym->mod_name
-		 && strcmp (bind_c_sym->mod_name, sym->module) != 0)
-		|| sym->attr.use_assoc == 0)
-              {
-                gfc_error ("Binding label '%s' at %L collides with global "
-                           "entity '%s' at %L", sym->binding_label,
-                           &(sym->declared_at), bind_c_sym->name,
-                           &(bind_c_sym->where));
-                has_error = 1;
-              }
-
-          if (has_error != 0)
-	    /* Clear the binding label to prevent checking multiple times.  */
-	    sym->binding_label = NULL;
-        }
-      else if (bind_c_sym == NULL)
-	{
-	  bind_c_sym = gfc_get_gsymbol (sym->binding_label);
-	  bind_c_sym->where = sym->declared_at;
-	  bind_c_sym->sym_name = sym->name;
+  gsym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label);
+
+  if (sym->module)
+    module = sym->module;
+  else if (sym->ns && sym->ns->proc_name
+	   && sym->ns->proc_name->attr.flavor == FL_MODULE)
+    module = sym->ns->proc_name->name;
+  else if (sym->ns && sym->ns->parent
+	   && sym->ns && sym->ns->parent->proc_name
+	   && sym->ns->parent->proc_name->attr.flavor == FL_MODULE)
+    module = sym->ns->parent->proc_name->name;
+  else
+    module = NULL;
+
+  if (!gsym
+      || (!gsym->defined
+	  && (gsym->type == GSYM_FUNCTION || gsym->type == GSYM_SUBROUTINE)))
+    {
+      if (!gsym)
+	gsym = gfc_get_gsymbol (sym->binding_label);
+      gsym->where = sym->declared_at;
+      gsym->sym_name = sym->name;
+      gsym->binding_label = sym->binding_label;
+      gsym->binding_label = sym->binding_label;
+      gsym->ns = sym->ns;
+      gsym->mod_name = module;
+      if (sym->attr.function)
+        gsym->type = GSYM_FUNCTION;
+      else if (sym->attr.subroutine)
+	gsym->type = GSYM_SUBROUTINE;
+      /* Mark as variable/procedure as defined, unless its an INTERFACE.  */
+      gsym->defined = sym->attr.if_source != IFSRC_IFBODY;
+      return;
+    }
 
-          if (sym->attr.use_assoc == 1)
-            bind_c_sym->mod_name = sym->module;
-          else
-            if (sym->ns->proc_name != NULL)
-              bind_c_sym->mod_name = sym->ns->proc_name->name;
+  if (sym->attr.flavor == FL_VARIABLE && gsym->type != GSYM_UNKNOWN)
+    {
+      gfc_error ("Variable %s with binding label %s at %L uses the same global "
+		 "identifier as entity at %L", sym->name,
+		 sym->binding_label, &sym->declared_at, &gsym->where);
+      /* Clear the binding label to prevent checking multiple times.  */
+      sym->binding_label = NULL;
 
-          if (sym->attr.contained == 0)
-            {
-              if (sym->attr.subroutine)
-                bind_c_sym->type = GSYM_SUBROUTINE;
-              else if (sym->attr.function)
-                bind_c_sym->type = GSYM_FUNCTION;
-            }
-        }
     }
-  return;
+  else if (sym->attr.flavor == FL_VARIABLE
+	   && (strcmp (module, gsym->mod_name) != 0
+	       || strcmp (sym->name, gsym->sym_name) != 0))
+    {
+      /* This can only happen if the variable is defined in a module - if it
+	 isn't the same module, reject it.  */
+      gfc_error ("Variable %s from module %s with binding label %s at %L uses "
+		 "the same global identifier as entity at %L from module %s",
+		 sym->name, module, sym->binding_label,
+		 &sym->declared_at, &gsym->where, gsym->mod_name);
+      sym->binding_label = NULL;
+    }
+  else if ((sym->attr.function || sym->attr.subroutine)
+	   && ((gsym->type != GSYM_SUBROUTINE && gsym->type != GSYM_FUNCTION)
+	       || (gsym->defined && sym->attr.if_source != IFSRC_IFBODY))
+	   && sym != gsym->ns->proc_name
+	   && (strcmp (gsym->sym_name, sym->name) != 0
+	       || module != gsym->mod_name
+	       || (module && strcmp (module, gsym->mod_name) != 0)))
+    {
+      /* Print an error if the procdure is defined multiple times; we have to
+	 exclude references to the same procedure via module association or
+	 multiple checks for the same procedure.  */
+      gfc_error ("Procedure %s with binding label %s at %L uses the same "
+		 "global identifier as entity at %L", sym->name,
+		 sym->binding_label, &sym->declared_at, &gsym->where);
+      sym->binding_label = NULL;
+    }
 }
 
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 795057b9928..100ec18be51 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1646,6 +1646,14 @@ gfc_get_extern_function_decl (gfc_symbol * sym)
   gsym =  gfc_find_gsymbol (gfc_gsym_root, sym->binding_label
 					   ? sym->binding_label : sym->name);
 
+  if (gsym && !gsym->defined)
+    gsym = NULL;
+
+  /* This can happen because of C binding.  */
+  if (gsym && gsym->ns && gsym->ns->proc_name
+      && gsym->ns->proc_name->attr.flavor == FL_MODULE)
+    goto module_sym;
+
   if ((!sym->attr.use_assoc || sym->attr.if_source != IFSRC_DECL)
       && !sym->backend_decl
       && gsym && gsym->ns
@@ -1702,12 +1710,19 @@ gfc_get_extern_function_decl (gfc_symbol * sym)
   if (sym->module)
     gsym =  gfc_find_gsymbol (gfc_gsym_root, sym->module);
 
-  if (gsym && gsym->ns && gsym->type == GSYM_MODULE)
+module_sym:
+  if (gsym && gsym->ns
+      && (gsym->type == GSYM_MODULE
+	  || (gsym->ns->proc_name && gsym->ns->proc_name->attr.flavor == FL_MODULE)))
     {
       gfc_symbol *s;
 
       s = NULL;
-      gfc_find_symbol (sym->name, gsym->ns, 0, &s);
+      if (gsym->type == GSYM_MODULE)
+	gfc_find_symbol (sym->name, gsym->ns, 0, &s);
+      else
+	gfc_find_symbol (gsym->sym_name, gsym->ns, 0, &s);
+
       if (s && s->backend_decl)
 	{
 	  if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)