Patchwork [Fortran] PR48858/55465 - permit multiple bind(C) declarations (but not definitions) for the same proc

login
register
mail settings
Submitter Tobias Burnus
Date May 17, 2013, 6:45 a.m.
Message ID <5195D1FE.4060900@net-b.de>
Download mbox | patch
Permalink /patch/244508/
State New
Headers show

Comments

Tobias Burnus - May 17, 2013, 6:45 a.m.
Followup (and depending on) to the C binding patches for
* COMMON: http://gcc.gnu.org/ml/fortran/2013-05/msg00048.html
* Procedures: http://gcc.gnu.org/ml/fortran/2013-05/msg00051.html
which honour Fortran 2008, where the Fortran name is no longer a global 
identifier if a binding name has been specified.

The main reason for this patch is a build failure of Open MPI (requires 
!gcc$ attributes no_arg_check, i.e. it only affects GCC 4.9). Open MPI 
uses somethine like:
   interface
     subroutine pmpi_something() bind(C,name="MPI_something")
   ...
and in a different module:
   interface
     subroutine mpi_something() bind(C,name="MPI_something")
   ...

Currently, gfortran rejects it because it only permits one 
definition/declaration per translation unit. However, there is no reason 
why multiple INTERFACE blocks shouldn't be permitted.


Remarks:

a) Better argument checks if definition and declaration are in the same 
file. (see INTENT patch in a test case)

b) Currently, no check is done regarding the characteristic of procedure 
declarations. Of course, the declaration has to be compatible with the C 
procedure. However, there seems to be the wish* to permit compatible 
input - even if the Fortran characteristic is different. For instance 
"int *" takes both a scalar integer ("int i; f(&i)") and arrays ("int 
i[5]; f(i)"). Or also popular according to the PRs: Taking a C_LOC or an 
integer(c_intptr_t).

(* Seemingly, also J3 and/or WG5 discussed this (plenum? subgroups?) and 
they had the permit it. However, finding some official document is 
difficult.)

I was wondering for a while what should be permitted and what shouldn't, 
but I have now decided to put that completely into the hands of the user.


Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias
Tobias Burnus - May 20, 2013, 6:28 p.m.
* PING *

Since today, due to a just committed patch, Open MPI (trunk version)  
won't compile with GCC 4.9 without this patch ...

Patches in this trilogy - the last one is required for Open MPI:
*http://gcc.gnu.org/ml/fortran/2013-05/msg00048.html  - COMMON
*http://gcc.gnu.org/ml/fortran/2013-05/msg00051.html  - PROCEDURE

* http://gcc.gnu.org/ml/fortran/2013-05/msg00056.html - more on bind 
label handling

On May 17, 2013 08:45, Tobias Burnus wrote:
> Followup (and depending on) to the C binding patches for
> * COMMON: http://gcc.gnu.org/ml/fortran/2013-05/msg00048.html
> * Procedures: http://gcc.gnu.org/ml/fortran/2013-05/msg00051.html
> which honour Fortran 2008, where the Fortran name is no longer a 
> global identifier if a binding name has been specified.
>
> The main reason for this patch is a build failure of Open MPI 
> (requires !gcc$ attributes no_arg_check, i.e. it only affects GCC 
> 4.9). Open MPI uses somethine like:
>   interface
>     subroutine pmpi_something() bind(C,name="MPI_something")
>   ...
> and in a different module:
>   interface
>     subroutine mpi_something() bind(C,name="MPI_something")
>   ...
>
> Currently, gfortran rejects it because it only permits one 
> definition/declaration per translation unit. However, there is no 
> reason why multiple INTERFACE blocks shouldn't be permitted.
>
>
> Remarks:
>
> a) Better argument checks if definition and declaration are in the 
> same file. (see INTENT patch in a test case)
>
> b) Currently, no check is done regarding the characteristic of 
> procedure declarations. Of course, the declaration has to be 
> compatible with the C procedure. However, there seems to be the wish* 
> to permit compatible input - even if the Fortran characteristic is 
> different. For instance "int *" takes both a scalar integer ("int i; 
> f(&i)") and arrays ("int i[5]; f(i)"). Or also popular according to 
> the PRs: Taking a C_LOC or an integer(c_intptr_t).
>
> (* Seemingly, also J3 and/or WG5 discussed this (plenum? subgroups?) 
> and they had the permit it. However, finding some official document is 
> difficult.)
>
> I was wondering for a while what should be permitted and what 
> shouldn't, but I have now decided to put that completely into the 
> hands of the user.
>
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
>
> Tobias
Thomas Koenig - May 20, 2013, 6:52 p.m.
Hi Tobias,

> * PING *
>
> Since today, due to a just committed patch, Open MPI (trunk version)
> won't compile with GCC 4.9 without this patch ...
>
> Patches in this trilogy - the last one is required for Open MPI:
> *http://gcc.gnu.org/ml/fortran/2013-05/msg00048.html  - COMMON
> *http://gcc.gnu.org/ml/fortran/2013-05/msg00051.html  - PROCEDURE
>
> * http://gcc.gnu.org/ml/fortran/2013-05/msg00056.html - more on bind
> label handling

All are OK.  Please commit separately ;-)

Thanks for the patches!

	Thomas

Patch

2013-05-17  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-17  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.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index cb449a2..6ab9cc7 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 ba1730a..a223a2c 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 f3607b4..74e0aa4 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 795057b..100ec18 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)
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03
index 8424922..2a4a53b 100644
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03
@@ -4,10 +4,10 @@ 
 module binding_label_tests_10_main
   use iso_c_binding
   implicit none
-  integer(c_int), bind(c,name="c_one") :: one ! { dg-error "collides" }
+  integer(c_int), bind(c,name="c_one") :: one ! { dg-error "Variable one from module binding_label_tests_10 with binding label c_one at .1. uses the same global identifier as entity at .2. from module binding_label_tests_10_main" }
 end module binding_label_tests_10_main
 
 program main
-  use binding_label_tests_10 ! { dg-error "collides" }
+  use binding_label_tests_10 ! { dg-error "Variable one from module binding_label_tests_10 with binding label c_one at .1. uses the same global identifier as entity at .2. from module binding_label_tests_10_main" }
   use binding_label_tests_10_main
 end program main
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03
index ef7cfce..851c32c 100644
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03
@@ -5,14 +5,14 @@  module binding_label_tests_11_main
   use iso_c_binding, only: c_int
   implicit none
 contains
-  function one() bind(c, name="c_one") ! { dg-error "collides" }
+  function one() bind(c, name="c_one") ! { dg-error "Procedure one with binding label c_one at .1. uses the same global identifier as entity at .2." }
     integer(c_int) one
     one = 1
   end function one
 end module binding_label_tests_11_main
 
 program main
-  use binding_label_tests_11 ! { dg-error "collides" }
+  use binding_label_tests_11 ! { dg-error "Procedure one with binding label c_one at .1. uses the same global identifier as entity at .2." }
   use binding_label_tests_11_main
 end program main
 ! { dg-final { cleanup-modules "binding_label_tests_11" } }
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03
index 355f11a..da93a8b 100644
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03
@@ -4,12 +4,12 @@ 
 ! binding_label_tests_13.mod can not be removed until after this test is done.
 module binding_label_tests_13_main
   use, intrinsic :: iso_c_binding, only: c_int
-  integer(c_int) :: c3 ! { dg-error "collides" }
+  integer(c_int) :: c3  ! { dg-error "Variable c3 from module binding_label_tests_13_main with binding label c3 at .1. uses the same global identifier as entity at .2. from module binding_label_tests_13" }
   bind(c) c3
 
 contains
   subroutine c_sub() BIND(c, name = "C_Sub")
-    use binding_label_tests_13 ! { dg-error "collides" }
+    use binding_label_tests_13 ! { dg-error "Variable c3 from module binding_label_tests_13_main with binding label c3 at .1. uses the same global identifier as entity at .2. from module binding_label_tests_13" }
   end subroutine c_sub
 end module binding_label_tests_13_main
 ! { dg-final { cleanup-modules "binding_label_tests_13" } }
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_3.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_3.f03
index 6e12447..429fa0b 100644
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_3.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_3.f03
@@ -2,14 +2,14 @@ 
 program main
 use iso_c_binding
   interface
-     subroutine p1(f, a1, a2, a3, a4) bind(c, name='printf') ! { dg-error "collides" }
+     subroutine p1(f, a1, a2, a3, a4) bind(c, name='printf') ! Doubtful use ...
        import :: c_ptr, c_int, c_double
        type(c_ptr), value :: f
        integer(c_int), value :: a1, a3
        real(c_double), value :: a2, a4
      end subroutine p1
 
-     subroutine p2(f, a1, a2, a3, a4) bind(c, name='printf') ! { dg-error "collides" }
+     subroutine p2(f, a1, a2, a3, a4) bind(c, name='printf') ! ... with incompatible interfaces
        import :: c_ptr, c_int, c_double
        type(c_ptr), value :: f
        real(c_double), value :: a1, a3
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03
index 5a0767d..455726e 100644
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03
@@ -2,7 +2,7 @@ 
 module A
   use, intrinsic :: iso_c_binding
 contains
-  subroutine pA() bind(c, name='printf') ! { dg-error "collides" }
+  subroutine pA() bind(c, name='printf') ! { dg-error "Procedure pb with binding label printf at .1. uses the same global identifier as entity at .2." }
     print *, 'hello from pA'
   end subroutine pA
 end module A
@@ -11,7 +11,7 @@  module B
   use, intrinsic :: iso_c_binding
 
 contains
-  subroutine pB() bind(c, name='printf') ! { dg-error "collides" }
+  subroutine pB() bind(c, name='printf') ! { dg-error "Procedure pb with binding label printf at .1. uses the same global identifier as entity at .2." }
     print *, 'hello from pB'
   end subroutine pB
 end module B
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_5.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_5.f03
index c8aa4e8..41999b3 100644
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_5.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_5.f03
@@ -3,10 +3,10 @@  module binding_label_tests_5
   use, intrinsic :: iso_c_binding
   
   interface
-     subroutine sub0() bind(c, name='c_sub') ! { dg-error "collides" }
+     subroutine sub0() bind(c, name='c_sub') ! Odd declaration but perfectly valid
      end subroutine sub0
      
-     subroutine sub1() bind(c, name='c_sub') ! { dg-error "collides" }
+     subroutine sub1() bind(c, name='c_sub') ! Ditto.
      end subroutine sub1
   end interface
 end module binding_label_tests_5
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03
index 0784de1..d213819 100644
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03
@@ -1,6 +1,6 @@ 
 ! { dg-do compile }
 module binding_label_tests_6
   use, intrinsic :: iso_c_binding
-  integer(c_int), bind(c, name='my_int') :: my_f90_int_1 ! { dg-error "collides" }
-  integer(c_int), bind(c, name='my_int') :: my_f90_int_2 ! { dg-error "collides" }
+  integer(c_int), bind(c, name='my_int') :: my_f90_int_1 ! { dg-error "Variable my_f90_int_2 from module binding_label_tests_6 with binding label my_int at .1. uses the same global identifier as entity at .2. from module binding_label_tests_6" }
+  integer(c_int), bind(c, name='my_int') :: my_f90_int_2 ! { dg-error "Variable my_f90_int_2 from module binding_label_tests_6 with binding label my_int at .1. uses the same global identifier as entity at .2. from module binding_label_tests_6" }
 end module binding_label_tests_6
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03
index 1234bb5..1e261a9 100644
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03
@@ -1,13 +1,13 @@ 
 ! { dg-do compile }
 module A
   use, intrinsic :: iso_c_binding, only: c_int
-  integer(c_int), bind(c, name='my_c_print') :: my_int ! { dg-error "collides" }
+  integer(c_int), bind(c, name='my_c_print') :: my_int ! { dg-error "Procedure my_c_print with binding label my_c_print at .1. uses the same global identifier as entity at .2." }
 end module A
 
 program main
 use A
 interface
-   subroutine my_c_print() bind(c) ! { dg-error "collides" }
+   subroutine my_c_print() bind(c) ! { dg-error "Procedure my_c_print with binding label my_c_print at .1. uses the same global identifier as entity at .2." }
    end subroutine my_c_print
 end interface
 
diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03
index c49ee62..2f507b9 100644
--- a/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03
+++ b/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03
@@ -1,9 +1,9 @@ 
 ! { dg-do compile }
 module binding_label_tests_8
   use, intrinsic :: iso_c_binding, only: c_int
-  integer(c_int), bind(c, name='my_f90_sub') :: my_c_int ! { dg-error "collides" }
+  integer(c_int), bind(c, name='my_f90_sub') :: my_c_int  ! { dg-error "Variable my_c_int with binding label my_f90_sub at .1. uses the same global identifier as entity at .2." }
 
 contains
-  subroutine my_f90_sub() bind(c) ! { dg-error "collides" }
+  subroutine my_f90_sub() bind(c) ! { dg-error "Variable my_c_int with binding label my_f90_sub at .1. uses the same global identifier as entity at .2." }
   end subroutine my_f90_sub
 end module binding_label_tests_8
diff --git a/gcc/testsuite/gfortran.dg/c_loc_tests_12.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_12.f03
index cfc7be5..9ebfd08 100644
--- a/gcc/testsuite/gfortran.dg/c_loc_tests_12.f03
+++ b/gcc/testsuite/gfortran.dg/c_loc_tests_12.f03
@@ -23,7 +23,7 @@  program test2
   interface
     subroutine sub1(argv) bind(c)
       import
-      type(c_ptr) :: argv
+      type(c_ptr), intent(in) :: argv
     end subroutine sub1
   end interface
   call sub1(c_loc(argv))
--- /dev/null	2013-05-17 07:55:08.381111723 +0200
+++ gcc/gcc/testsuite/gfortran.dg/binding_label_tests_24.f90	2013-05-17 08:16:23.750676503 +0200
@@ -0,0 +1,28 @@ 
+! { dg-do compile }
+!
+! PR fortran/48858
+! PR fortran/55465
+!
+! Was rejected before but it perfectly valid
+!
+module m
+  interface
+    subroutine f() bind(C, name="func")
+    end subroutine
+  end interface
+contains
+  subroutine sub()
+     call f()
+  end subroutine
+end module m
+
+module m2
+  interface
+    subroutine g() bind(C, name="func")
+    end subroutine
+  end interface
+contains
+  subroutine sub2()
+     call g()
+  end subroutine
+end module m2
--- /dev/null	2013-05-17 07:55:08.381111723 +0200
+++ gcc/gcc/testsuite/gfortran.dg/binding_label_tests_25.f90	2013-05-17 08:20:17.424950188 +0200
@@ -0,0 +1,61 @@ 
+! { dg-do compile }
+!
+! PR fortran/48858
+! PR fortran/55465
+!
+! Seems to be regarded as valid, even if it is doubtful
+!
+
+
+module m_odbc_if
+  implicit none
+
+  interface sql_set_env_attr
+    function sql_set_env_attr_int( input_handle,attribute,value,length ) &
+                                   result(res) bind(C,name="SQLSetEnvAttr")
+      use, intrinsic :: iso_c_binding
+      implicit none
+      type(c_ptr), value :: input_handle
+      integer(c_int), value :: attribute
+      integer(c_int), value :: value  ! <<<< HERE: int passed by value (int with ptr address)
+      integer(c_int), value :: length      
+      integer(c_short) :: res
+    end function
+    function sql_set_env_attr_ptr( input_handle,attribute,value,length ) &
+                                   result(res) bind(C,name="SQLSetEnvAttr")
+      use, intrinsic :: iso_c_binding
+      implicit none
+      type(c_ptr), value :: input_handle
+      integer(c_int), value :: attribute
+      type(c_ptr), value :: value ! <<< HERE: "void *" (pointer address)
+      integer(c_int), value :: length      
+      integer(c_short) :: res
+    end function
+  end interface
+end module
+
+module graph_partitions
+  use,intrinsic :: iso_c_binding
+
+  interface Cfun
+     subroutine cfunc1 (num, array) bind(c, name="Cfun")
+       import :: c_int
+       integer(c_int),value :: num
+       integer(c_int)       :: array(*) ! <<< HERE: int[]
+     end subroutine cfunc1
+
+     subroutine cfunf2 (num, array) bind(c, name="Cfun")
+       import :: c_int, c_ptr
+       integer(c_int),value :: num
+       type(c_ptr),value    :: array ! <<< HERE: void*
+     end subroutine cfunf2
+  end interface
+end module graph_partitions
+
+program test
+  use graph_partitions
+  integer(c_int) :: a(100)
+
+  call Cfun (1, a)
+  call Cfun (2, C_NULL_PTR)
+end program test