re PR fortran/48858 (Incorrect error for same binding label on two generic interface specifics)

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.

From-SVN: r199120

gcc/fortran/ChangeLog

 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.

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;

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;

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;
+    }
 }
 
 

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)

gcc/testsuite/ChangeLog

 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.
+
+2013-05-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/48858
 	* gfortran.dg/binding_label_tests_17.f90: New.
 	* gfortran.dg/binding_label_tests_18.f90: New.
 	* gfortran.dg/binding_label_tests_19.f90: New.

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

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" } }

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" } }

gcc/testsuite/gfortran.dg/binding_label_tests_24.f90

+! { 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

gcc/testsuite/gfortran.dg/binding_label_tests_25.f90

+! { 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

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

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

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

gcc/testsuite/gfortran.dg/binding_label_tests_6.f03

 ! { 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

gcc/testsuite/gfortran.dg/binding_label_tests_7.f03

 ! { 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
 

gcc/testsuite/gfortran.dg/binding_label_tests_8.f03

 ! { 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

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))