Fortran : ICE in build_field PR95614
authorMark Eggleston <markeggleston@gcc.gnu.org>
Thu, 11 Jun 2020 13:33:51 +0000 (14:33 +0100)
committerMark Eggleston <markeggleston@gcc.gnu.org>
Wed, 14 Oct 2020 10:08:09 +0000 (11:08 +0100)
Local identifiers can not be the same as a module name.  Original
patch by Steve Kargl resulted in name clashes between common block
names and local identifiers.  A local identifier can be the same as
a global identier if that identifier is not a module or a program.
The original patch was modified to reject global identifiers that
represent a module or a program.

2020-10-14  Steven G. Kargl  <kargl@gcc.gnu.org>
    Mark Eggleston  <markeggleston@gcc.gnu.org>

gcc/fortran/ChangeLog:

PR fortran/95614
* decl.c (gfc_get_common): Use gfc_match_common_name instead
of match_common_name.
* decl.c (gfc_bind_idents): Use gfc_match_common_name instead
of match_common_name.
* match.c : Rename match_common_name to gfc_match_common_name.
* match.c (gfc_match_common): Use gfc_match_common_name instead
of match_common_name.
* match.h : Rename match_common_name to gfc_match_common_name.
* resolve.c (resolve_common_vars): Check each symbol in a
common block has a global symbol.  If there is a global symbol
issue an error if the symbol type is a module or a program.

2020-10-14  Mark Eggleston  <markeggleston@gcc.gnu.org>

gcc/testsuite/ChangeLog:

PR fortran/95614
* gfortran.dg/pr95614_1.f90: New test.
* gfortran.dg/pr95614_2.f90: New test.
* gfortran.dg/pr95614_3.f90: New test.
* gfortran.dg/pr95614_4.f90: New test.

gcc/fortran/decl.c
gcc/fortran/match.c
gcc/fortran/match.h
gcc/fortran/resolve.c
gcc/testsuite/gfortran.dg/pr95614_1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/pr95614_2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/pr95614_3.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/pr95614_4.f90 [new file with mode: 0644]

index bddf69cce19830dff781a225579638b633e09153..6df32068777b04f52219e86380d4037965b15397 100644 (file)
@@ -6007,7 +6007,7 @@ get_bind_c_idents (void)
       found_id = MATCH_YES;
       gfc_get_ha_symbol (name, &tmp_sym);
     }
-  else if (match_common_name (name) == MATCH_YES)
+  else if (gfc_match_common_name (name) == MATCH_YES)
     {
       found_id = MATCH_YES;
       com_block = gfc_get_common (name, 0);
@@ -6052,7 +6052,7 @@ get_bind_c_idents (void)
              found_id = MATCH_YES;
              gfc_get_ha_symbol (name, &tmp_sym);
            }
-         else if (match_common_name (name) == MATCH_YES)
+         else if (gfc_match_common_name (name) == MATCH_YES)
            {
              found_id = MATCH_YES;
              com_block = gfc_get_common (name, 0);
index cb09c5f8ec535d8fedd14b3a5585350dc0a74e73..bee73e7b00800e7e1e816d953a68d1e51b522e2d 100644 (file)
@@ -5166,7 +5166,8 @@ gfc_get_common (const char *name, int from_module)
 
 /* Match a common block name.  */
 
-match match_common_name (char *name)
+match
+gfc_match_common_name (char *name)
 {
   match m;
 
@@ -5218,7 +5219,7 @@ gfc_match_common (void)
 
   for (;;)
     {
-      m = match_common_name (name);
+      m = gfc_match_common_name (name);
       if (m == MATCH_ERROR)
        goto cleanup;
 
index 7bf70d77016e672c45d131129a87f9648c71ad43..4ccb5961d2b1d8d8c18cf29232e5ad09ed1834fb 100644 (file)
@@ -103,11 +103,9 @@ match gfc_match_call (void);
 
 /* We want to use this function to check for a common-block-name
    that can exist in a bind statement, so removed the "static"
-   declaration of the function in match.c.
+   declaration of the function in match.c. */
  
-   TODO: should probably rename this now that it'll be globally seen to
-   gfc_match_common_name.  */
-match match_common_name (char *name);
+match gfc_match_common_name (char *name);
 
 match gfc_match_common (void);
 match gfc_match_block_data (void);
index f4ce49f84323b425cd283714653b34df95a4c998..a210f9aad43e8245f3bb8348bba29e2bf82b5428 100644 (file)
@@ -936,9 +936,16 @@ static void
 resolve_common_vars (gfc_common_head *common_block, bool named_common)
 {
   gfc_symbol *csym = common_block->head;
+  gfc_gsymbol *gsym;
 
   for (; csym; csym = csym->common_next)
     {
+      gsym = gfc_find_gsymbol (gfc_gsym_root, csym->name);
+      if (gsym && (gsym->type == GSYM_MODULE || gsym->type == GSYM_PROGRAM))
+       gfc_error_now ("Global entity %qs at %L cannot appear in a "
+                       "COMMON block at %L", gsym->name,
+                       &gsym->where, &csym->common_block->where);
+
       /* gfc_add_in_common may have been called before, but the reported errors
         have been ignored to continue parsing.
         We do the checks again here.  */
diff --git a/gcc/testsuite/gfortran.dg/pr95614_1.f90 b/gcc/testsuite/gfortran.dg/pr95614_1.f90
new file mode 100644 (file)
index 0000000..f835143
--- /dev/null
@@ -0,0 +1,6 @@
+! { dg-do compile }
+
+module m   ! { dg-error ".1." }
+  common m ! { dg-error "cannot appear in a COMMON" }
+end
+
diff --git a/gcc/testsuite/gfortran.dg/pr95614_2.f90 b/gcc/testsuite/gfortran.dg/pr95614_2.f90
new file mode 100644 (file)
index 0000000..9d69a50
--- /dev/null
@@ -0,0 +1,6 @@
+! { dg-do compile }
+
+module m        ! { dg-error ".1." }
+  common /xc/ m ! { dg-error "cannot appear in a COMMON" }
+end
+
diff --git a/gcc/testsuite/gfortran.dg/pr95614_3.f90 b/gcc/testsuite/gfortran.dg/pr95614_3.f90
new file mode 100644 (file)
index 0000000..7a66bec
--- /dev/null
@@ -0,0 +1,9 @@
+! { dg-do compile }
+
+subroutine s
+end subroutine
+
+program pr95614
+  common /c1/ s
+  s = 9.0
+end program
diff --git a/gcc/testsuite/gfortran.dg/pr95614_4.f90 b/gcc/testsuite/gfortran.dg/pr95614_4.f90
new file mode 100644 (file)
index 0000000..48f9b9b
--- /dev/null
@@ -0,0 +1,9 @@
+! { dg-do compile }
+
+function f()
+  f = 1.0
+end function
+
+program pr95614
+  common /c1/ f
+end program