Patchwork [Fortran] PR48858 - COMMON - Fix global/local identifier issues with C binding

login
register
mail settings
Submitter Tobias Burnus
Date May 13, 2013, 5:30 p.m.
Message ID <51912335.306@net-b.de>
Download mbox | patch
Permalink /patch/243467/
State New
Headers show

Comments

Tobias Burnus - May 13, 2013, 5:30 p.m.
First, it adds a missing -std=f95 check for Fortran 2003's BIND(C) 
statement.


Secondly, it honors the COMMON identifier changes of Fortran 2008. In 
Fortran 2003, one has:

"The name of a program unit, common block, or external procedure is a 
global identifier and shall not be the same as the name of any other 
such global entity in the same program." (16.1 Scope of global identifiers)

In Fortran 2008 it has been modified to:

"The name of a common block with no binding label, external procedure 
with no binding label, or program unit that is not a submodule is a 
global identifier." (16.2 Scope of global identifiers)

Thus, this patch only generates a "gsym" if a common block either has no 
binding label or -std=f2003 is used. Additionally, it ensures in 
trans-common.c that this is correctly handled.


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

Tobias

PS: Still to be done is a similar change for procedures. Except that for 
procedures even more changes are required, e.g. having two identical 
INTERFACE (with different Fortran name but same binding name) is valid.
Tobias Burnus - May 18, 2013, 4:29 p.m.
* PING *

Patches in this trilogy:
* 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

Especially the first one should be rather simple to review.

Tobias

On May 13, 2013 Tobias Burnus wrote:
> First, it adds a missing -std=f95 check for Fortran 2003's BIND(C) 
> statement.
>
>
> Secondly, it honors the COMMON identifier changes of Fortran 2008. In 
> Fortran 2003, one has:
>
> "The name of a program unit, common block, or external procedure is a 
> global identifier and shall not be the same as the name of any other 
> such global entity in the same program." (16.1 Scope of global 
> identifiers)
>
> In Fortran 2008 it has been modified to:
>
> "The name of a common block with no binding label, external procedure 
> with no binding label, or program unit that is not a submodule is a 
> global identifier." (16.2 Scope of global identifiers)
>
> Thus, this patch only generates a "gsym" if a common block either has 
> no binding label or -std=f2003 is used. Additionally, it ensures in 
> trans-common.c that this is correctly handled.
>
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?
>
> Tobias
>
> PS: Still to be done is a similar change for procedures. Except that 
> for procedures even more changes are required, e.g. having two 
> identical INTERFACE (with different Fortran name but same binding 
> name) is valid.

Patch

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

	PR fortran/48858
	* decl.c (gfc_match_bind_c_stmt): Add gfc_notify_std.
	* match.c (gfc_match_common): Don't add commons to gsym.
	* resolve.c (resolve_common_blocks): Add to gsym and
	add checks.
	(resolve_bind_c_comms): Remove.
	(resolve_types): Remove call to the latter.
	* trans-common.c (gfc_common_ns): Remove static var.
	(gfc_map_of_all_commons): Add static var.
	(build_common_decl): Correctly handle binding label.

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

	PR fortran/48858
	* gfortran.dg/test_common_binding_labels.f03: Update dg-error.
	* gfortran.dg/test_common_binding_labels_2_main.f03: Ditto.
	* gfortran.dg/test_common_binding_labels_3_main.f03: Ditto.
	* gfortran.dg/common_18.f90: New.
	* gfortran.dg/common_19.f90: New.
	* gfortran.dg/common_20.f90: New.
	* gfortran.dg/common_21.f90: New.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 6ae51e2..06a049c 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -4208,6 +4208,9 @@  gfc_match_bind_c_stmt (void)
 
   if (found_match == MATCH_YES)
     {
+      if (!gfc_notify_std (GFC_STD_F2003, "BIND(C) statement at %C"))
+	return MATCH_ERROR;
+
       /* Look for the :: now, but it is not required.  */
       gfc_match (" :: ");
 
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 07f8f63..b44d815 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -4332,7 +4332,6 @@  gfc_match_common (void)
   gfc_array_spec *as;
   gfc_equiv *e1, *e2;
   match m;
-  gfc_gsymbol *gsym;
 
   old_blank_common = gfc_current_ns->blank_common.head;
   if (old_blank_common)
@@ -4349,23 +4348,6 @@  gfc_match_common (void)
       if (m == MATCH_ERROR)
 	goto cleanup;
 
-      gsym = gfc_get_gsymbol (name);
-      if (gsym->type != GSYM_UNKNOWN && gsym->type != GSYM_COMMON)
-	{
-	  gfc_error ("Symbol '%s' at %C is already an external symbol that "
-		     "is not COMMON", name);
-	  goto cleanup;
-	}
-
-      if (gsym->type == GSYM_UNKNOWN)
-	{
-	  gsym->type = GSYM_COMMON;
-	  gsym->where = gfc_current_locus;
-	  gsym->defined = 1;
-	}
-
-      gsym->used = 1;
-
       if (name[0] == '\0')
 	{
 	  t = &gfc_current_ns->blank_common;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e27b23b..06fa301 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -947,6 +947,7 @@  static void
 resolve_common_blocks (gfc_symtree *common_root)
 {
   gfc_symbol *sym;
+  gfc_gsymbol * gsym;
 
   if (common_root == NULL)
     return;
@@ -958,6 +959,84 @@  resolve_common_blocks (gfc_symtree *common_root)
 
   resolve_common_vars (common_root->n.common->head, true);
 
+  /* The common name is a global name - in Fortran 2003 also if it has a
+     C binding name, since Fortran 2008 only the C binding name is a global
+     identifier.  */
+  if (!common_root->n.common->binding_label
+      || gfc_notification_std (GFC_STD_F2008))
+    {
+      gsym = gfc_find_gsymbol (gfc_gsym_root,
+			       common_root->n.common->name);
+
+      if (gsym && gfc_notification_std (GFC_STD_F2008)
+	  && gsym->type == GSYM_COMMON
+	  && ((common_root->n.common->binding_label
+	       && (!gsym->binding_label
+		   || strcmp (common_root->n.common->binding_label,
+			      gsym->binding_label) != 0))
+	      || (!common_root->n.common->binding_label
+		  && gsym->binding_label)))
+	{
+	  gfc_error ("In Fortran 2003 COMMON '%s' block at %L is a global "
+		     "identifier and must thus have the same binding name "
+		     "as the same-named COMMON block at %L: %s vs %s",
+		     common_root->n.common->name, &common_root->n.common->where,
+		     &gsym->where,
+		     common_root->n.common->binding_label
+		     ? common_root->n.common->binding_label : "(blank)",
+		     gsym->binding_label ? gsym->binding_label : "(blank)");
+	  return;
+	}
+
+      if (gsym && gsym->type != GSYM_COMMON
+	  && !common_root->n.common->binding_label)
+	{
+	  gfc_error ("COMMON block '%s' at %L uses the same global identifier "
+		     "as entity at %L",
+		     common_root->n.common->name, &common_root->n.common->where,
+		     &gsym->where);
+	  return;
+	}
+      if (gsym && gsym->type != GSYM_COMMON)
+	{
+	  gfc_error ("Fortran 2008: COMMON block '%s' with binding label at "
+		     "%L sharing the identifier with global non-COMMON-block "
+		     "entity at %L", common_root->n.common->name,
+		     &common_root->n.common->where, &gsym->where);
+	  return;
+	}
+      if (!gsym)
+	{
+	  gsym = gfc_get_gsymbol (common_root->n.common->name);
+	  gsym->type = GSYM_COMMON;
+	  gsym->where = common_root->n.common->where;
+	  gsym->defined = 1;
+	}
+      gsym->used = 1;
+    }
+
+  if (common_root->n.common->binding_label)
+    {
+      gsym = gfc_find_gsymbol (gfc_gsym_root,
+			       common_root->n.common->binding_label);
+      if (gsym && gsym->type != GSYM_COMMON)
+	{
+	  gfc_error ("COMMON block at %L with binding label %s uses the same "
+		     "global identifier as entity at %L",
+		     &common_root->n.common->where,
+		     common_root->n.common->binding_label, &gsym->where);
+	  return;
+	}
+      if (!gsym)
+	{
+	  gsym = gfc_get_gsymbol (common_root->n.common->binding_label);
+	  gsym->type = GSYM_COMMON;
+	  gsym->where = common_root->n.common->where;
+	  gsym->defined = 1;
+	}
+      gsym->used = 1;
+    }
+
   gfc_find_symbol (common_root->name, gfc_current_ns, 0, &sym);
   if (sym == NULL)
     return;
@@ -9929,103 +10008,6 @@  resolve_values (gfc_symbol *sym)
 }
 
 
-/* Verify the binding labels for common blocks that are BIND(C).  The label
-   for a BIND(C) common block must be identical in all scoping units in which
-   the common block is declared.  Further, the binding label can not collide
-   with any other global entity in the program.  */
-
-static void
-resolve_bind_c_comms (gfc_symtree *comm_block_tree)
-{
-  if (comm_block_tree->n.common->is_bind_c == 1)
-    {
-      gfc_gsymbol *binding_label_gsym;
-      gfc_gsymbol *comm_name_gsym;
-      const char * bind_label = comm_block_tree->n.common->binding_label
-	? comm_block_tree->n.common->binding_label : "";
-
-      /* See if a global symbol exists by the common block's name.  It may
-         be NULL if the common block is use-associated.  */
-      comm_name_gsym = gfc_find_gsymbol (gfc_gsym_root,
-                                         comm_block_tree->n.common->name);
-      if (comm_name_gsym != NULL && comm_name_gsym->type != GSYM_COMMON)
-        gfc_error ("Binding label '%s' for common block '%s' at %L collides "
-                   "with the global entity '%s' at %L",
-                   bind_label,
-                   comm_block_tree->n.common->name,
-                   &(comm_block_tree->n.common->where),
-                   comm_name_gsym->name, &(comm_name_gsym->where));
-      else if (comm_name_gsym != NULL
-	       && strcmp (comm_name_gsym->name,
-			  comm_block_tree->n.common->name) == 0)
-        {
-          /* TODO: Need to make sure the fields of gfc_gsymbol are initialized
-             as expected.  */
-          if (comm_name_gsym->binding_label == NULL)
-            /* No binding label for common block stored yet; save this one.  */
-            comm_name_gsym->binding_label = bind_label;
-          else if (strcmp (comm_name_gsym->binding_label, bind_label) != 0)
-              {
-                /* Common block names match but binding labels do not.  */
-                gfc_error ("Binding label '%s' for common block '%s' at %L "
-                           "does not match the binding label '%s' for common "
-                           "block '%s' at %L",
-                           bind_label,
-                           comm_block_tree->n.common->name,
-                           &(comm_block_tree->n.common->where),
-                           comm_name_gsym->binding_label,
-                           comm_name_gsym->name,
-                           &(comm_name_gsym->where));
-                return;
-              }
-        }
-
-      /* There is no binding label (NAME="") so we have nothing further to
-         check and nothing to add as a global symbol for the label.  */
-      if (!comm_block_tree->n.common->binding_label)
-        return;
-
-      binding_label_gsym =
-        gfc_find_gsymbol (gfc_gsym_root,
-                          comm_block_tree->n.common->binding_label);
-      if (binding_label_gsym == NULL)
-        {
-          /* Need to make a global symbol for the binding label to prevent
-             it from colliding with another.  */
-          binding_label_gsym =
-            gfc_get_gsymbol (comm_block_tree->n.common->binding_label);
-          binding_label_gsym->sym_name = comm_block_tree->n.common->name;
-          binding_label_gsym->type = GSYM_COMMON;
-        }
-      else
-        {
-          /* If comm_name_gsym is NULL, the name common block is use
-             associated and the name could be colliding.  */
-          if (binding_label_gsym->type != GSYM_COMMON)
-            gfc_error ("Binding label '%s' for common block '%s' at %L "
-                       "collides with the global entity '%s' at %L",
-                       comm_block_tree->n.common->binding_label,
-                       comm_block_tree->n.common->name,
-                       &(comm_block_tree->n.common->where),
-                       binding_label_gsym->name,
-                       &(binding_label_gsym->where));
-          else if (comm_name_gsym != NULL
-		   && (strcmp (binding_label_gsym->name,
-			       comm_name_gsym->binding_label) != 0)
-		   && (strcmp (binding_label_gsym->sym_name,
-			       comm_name_gsym->name) != 0))
-            gfc_error ("Binding label '%s' for common block '%s' at %L "
-                       "collides with global entity '%s' at %L",
-                       binding_label_gsym->name, binding_label_gsym->sym_name,
-                       &(comm_block_tree->n.common->where),
-                       comm_name_gsym->name, &(comm_name_gsym->where));
-        }
-    }
-
-  return;
-}
-
-
 /* Verify any BIND(C) derived types in the namespace so we can report errors
    for them once, rather than for each variable declared of that type.  */
 
@@ -14425,9 +14407,6 @@  resolve_types (gfc_namespace *ns)
 
   gfc_traverse_ns (ns, gfc_verify_binding_labels);
 
-  if (ns->common_root != NULL)
-    gfc_traverse_symtree (ns->common_root, resolve_bind_c_comms);
-
   for (eq = ns->equiv; eq; eq = eq->next)
     resolve_equivalence (eq);
 
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index db0f385..e2234b1 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -92,6 +92,7 @@  along with GCC; see the file COPYING3.  If not see
    is examined for still-unused equivalence conditions.  We create a
    block for each merged equivalence list.  */
 
+#include <map>
 #include "config.h"
 #include "system.h"
 #include "coretypes.h"
@@ -116,7 +117,10 @@  typedef struct segment_info
 } segment_info;
 
 static segment_info * current_segment;
-static gfc_namespace *gfc_common_ns = NULL;
+
+/* Store decl of all common blocks in this translation unit; the first
+   tree is the identifier.  */
+static std::map<tree, tree> gfc_map_of_all_commons;
 
 
 /* Make a segment_info based on a symbol.  */
@@ -374,15 +378,11 @@  build_equiv_decl (tree union_type, bool is_init, bool is_saved)
 static tree
 build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
 {
-  gfc_symbol *common_sym;
-  tree decl;
+  tree decl, identifier;
 
-  /* Create a namespace to store symbols for common blocks.  */
-  if (gfc_common_ns == NULL)
-    gfc_common_ns = gfc_get_namespace (NULL, 0);
-
-  gfc_get_symbol (com->name, gfc_common_ns, &common_sym);
-  decl = common_sym->backend_decl;
+  identifier = gfc_sym_mangled_common_id (com);
+  decl = gfc_map_of_all_commons.count(identifier)
+	 ? gfc_map_of_all_commons[identifier] : NULL_TREE;
 
   /* Update the size of this common block as needed.  */
   if (decl != NULL_TREE)
@@ -419,9 +419,15 @@  build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
   /* If there is no backend_decl for the common block, build it.  */
   if (decl == NULL_TREE)
     {
-      decl = build_decl (input_location,
-			 VAR_DECL, get_identifier (com->name), union_type);
-      gfc_set_decl_assembler_name (decl, gfc_sym_mangled_common_id (com));
+      if (com->is_bind_c == 1 && com->binding_label)
+	decl = build_decl (input_location, VAR_DECL, identifier, union_type);
+      else
+	{
+	  decl = build_decl (input_location, VAR_DECL, get_identifier (com->name),
+			     union_type);
+	  gfc_set_decl_assembler_name (decl, identifier);
+	}
+
       TREE_PUBLIC (decl) = 1;
       TREE_STATIC (decl) = 1;
       DECL_IGNORED_P (decl) = 1;
@@ -449,7 +455,7 @@  build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
 
       /* Place the back end declaration for this common block in
          GLOBAL_BINDING_LEVEL.  */
-      common_sym->backend_decl = pushdecl_top_level (decl);
+      gfc_map_of_all_commons[identifier] = pushdecl_top_level (decl);
     }
 
   /* Has no initial values.  */
diff --git a/gcc/testsuite/gfortran.dg/common_18.f90 b/gcc/testsuite/gfortran.dg/common_18.f90
new file mode 100644
index 0000000..374eda8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_18.f90
@@ -0,0 +1,20 @@ 
+! { dg-do compile }
+!
+! PR fortran/48858
+!
+!
+use iso_c_binding
+contains
+subroutine one()
+  bind(C, name="com1") :: /foo/
+  integer(c_int) :: a
+  common /foo/ a
+end subroutine
+subroutine two()
+  integer(c_long) :: a
+  common /foo/ a
+end subroutine two
+end
+
+! { dg-final { scan-assembler "com1" } }
+! { dg-final { scan-assembler "foo_" } }
diff --git a/gcc/testsuite/gfortran.dg/common_19.f90 b/gcc/testsuite/gfortran.dg/common_19.f90
new file mode 100644
index 0000000..0204201
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_19.f90
@@ -0,0 +1,9 @@ 
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/48858
+!
+integer :: i
+common /foo/ i
+bind(C) :: /foo/ ! { dg-error "Fortran 2003: BIND.C. statement" }
+end
diff --git a/gcc/testsuite/gfortran.dg/common_20.f90 b/gcc/testsuite/gfortran.dg/common_20.f90
new file mode 100644
index 0000000..836a9ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_20.f90
@@ -0,0 +1,18 @@ 
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/48858
+!
+subroutine test
+  integer :: l, m
+  common /g/ l ! { dg-error "Fortran 2008: COMMON block 'g' with binding label at .1. sharing the identifier with global non-COMMON-block entity at .2." }
+  common /jj/ m ! { dg-error "Global name 'jj' at .1. is already being used as a COMMON at .2." }
+  bind(C,name="bar") :: /g/
+  bind(C,name="foo") :: /jj/
+end
+
+subroutine g ! { dg-error "Fortran 2008: COMMON block 'g' with binding label at .1. sharing the identifier with global non-COMMON-block entity at .2." }
+  call jj()  ! { dg-error "Global name 'jj' at .1. is already being used as a COMMON at .2." }
+end
+
+
diff --git a/gcc/testsuite/gfortran.dg/common_21.f90 b/gcc/testsuite/gfortran.dg/common_21.f90
new file mode 100644
index 0000000..73a1b58
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/common_21.f90
@@ -0,0 +1,18 @@ 
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! PR fortran/48858
+!
+subroutine test
+  integer :: l, m
+  common /g/ l
+  common /jj/ m
+  bind(C,name="bar") :: /g/
+  bind(C,name="foo") :: /jj/
+end
+
+subroutine g
+  call jj()
+end
+
+
diff --git a/gcc/testsuite/gfortran.dg/test_common_binding_labels.f03 b/gcc/testsuite/gfortran.dg/test_common_binding_labels.f03
index 554a59d..8936fa8 100644
--- a/gcc/testsuite/gfortran.dg/test_common_binding_labels.f03
+++ b/gcc/testsuite/gfortran.dg/test_common_binding_labels.f03
@@ -1,9 +1,11 @@ 
 ! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
 module x
   use, intrinsic :: iso_c_binding, only: c_double
   implicit none
 
-  common /mycom/ r, s ! { dg-error "does not match" }
+  common /mycom/ r, s ! { dg-error "In Fortran 2003 COMMON 'mycom' block at .1. is a global identifier and must thus have the same binding name as the same-named COMMON block at .2.: my_common_block vs .blank.|In Fortran 2003 COMMON 'mycom' block at .1. is a global identifier and must thus have the same binding name as the same-named COMMON block at .2.: my_common_block_2 vs .blank." }
   real(c_double) :: r
   real(c_double) :: s
   bind(c, name="my_common_block") :: /mycom/
@@ -13,12 +15,12 @@  module y
   use, intrinsic :: iso_c_binding, only: c_double, c_int
   implicit none
   
-  common /mycom/ r, s
+  common /mycom/ r, s ! { dg-error "In Fortran 2003 COMMON 'mycom' block at .1. is a global identifier and must thus have the same binding name as the same-named COMMON block at .2.: my_common_block vs .blank." }
   real(c_double) :: r
   real(c_double) :: s
   bind(c, name="my_common_block") :: /mycom/
 
-  common /com2/ i ! { dg-error "does not match" }
+  common /com2/ i ! { dg-error " In Fortran 2003 COMMON 'com2' block at .1. is a global identifier and must thus have the same binding name as the same-named COMMON block at .2.: mycom2 vs .blank." }
   integer(c_int) :: i
   bind(c, name="") /com2/
 end module y
@@ -27,14 +29,14 @@  module z
   use, intrinsic :: iso_c_binding, only: c_double, c_int
   implicit none
   
-  common /mycom/ r, s ! { dg-error "does not match" }
+  common /mycom/ r, s ! { dg-error "In Fortran 2003 COMMON 'mycom' block at .1. is a global identifier and must thus have the same binding name as the same-named COMMON block at .2.: my_common_block_2 vs .blank." }
   real(c_double) :: r
   real(c_double) :: s
   ! this next line is an error; if a common block is bind(c), the binding label
   ! for it must match across all scoping units that declare it.
   bind(c, name="my_common_block_2") :: /mycom/ 
 
-  common /com2/ i ! { dg-error "does not match" }
+  common /com2/ i ! { dg-error " In Fortran 2003 COMMON 'com2' block at .1. is a global identifier and must thus have the same binding name as the same-named COMMON block at .2.: mycom2 vs .blank." }
   integer(c_int) :: i
   bind(c, name="mycom2") /com2/
 end module z
diff --git a/gcc/testsuite/gfortran.dg/test_common_binding_labels_2_main.f03 b/gcc/testsuite/gfortran.dg/test_common_binding_labels_2_main.f03
index eeb981e..fb7778e 100644
--- a/gcc/testsuite/gfortran.dg/test_common_binding_labels_2_main.f03
+++ b/gcc/testsuite/gfortran.dg/test_common_binding_labels_2_main.f03
@@ -1,24 +1,27 @@ 
 ! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+!
 ! This file depends on the module test_common_binding_labels_2.  That module
 ! must be compiled first and not be removed until after this test.
 module test_common_binding_labels_2_main
   use, intrinsic :: iso_c_binding, only: c_double, c_int
   implicit none
   
-  common /mycom/ r, s ! { dg-error "does not match" }
+  common /mycom/ r, s ! { dg-error "same binding name" }
   real(c_double) :: r
   real(c_double) :: s
   ! this next line is an error; if a common block is bind(c), the binding label
   ! for it must match across all scoping units that declare it.
   bind(c, name="my_common_block_2") :: /mycom/ 
 
-  common /com2/ i ! { dg-error "does not match" }
+  common /com2/ i ! { dg-error "same binding name" }
   integer(c_int) :: i
   bind(c, name="mycom2") /com2/
 end module test_common_binding_labels_2_main
 
 program main
-  use test_common_binding_labels_2 ! { dg-error "does not match" }
-  use test_common_binding_labels_2_main
+  use test_common_binding_labels_2 ! { dg-error "same binding name" }
+  use test_common_binding_labels_2_main ! { dg-error "same binding name" }
 end program main
 ! { dg-final { cleanup-modules "test_common_binding_labels_2" } }
diff --git a/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03 b/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03
index 91fcff1..3ccab0c 100644
--- a/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03
+++ b/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03
@@ -3,11 +3,11 @@ 
 ! must be compiled first and not be removed until after this test.
 module test_common_binding_labels_3_main
   use, intrinsic :: iso_c_binding, only: c_int
-  integer(c_int), bind(c, name="my_common_block") :: my_int ! { dg-error "collides" }
+  integer(c_int), bind(c, name="my_common_block") :: my_int ! { dg-error "COMMON block at .1. with binding label my_common_block uses the same global identifier as entity at .2." }
 end module test_common_binding_labels_3_main
 
 program main
   use test_common_binding_labels_3_main
-  use test_common_binding_labels_3 ! { dg-error "collides" }
+  use test_common_binding_labels_3 ! { dg-error "COMMON block at .1. with binding label my_common_block uses the same global identifier as entity at .2." }
 end program main
 ! { dg-final { cleanup-modules "test_common_binding_labels_3" } }