re PR fortran/13742 (Not Implemented: initial values for COMMON or EQUIVALENCE)

PR fortran/13742
* decl.c (add_init_expr_to_sym): Verify that COMMON variable is
not initialized in a disallowed fashion.
* match.c (gfc_match_common): Likewise.
(var_element): Verify that variable is not in the blank COMMON,
if it is in a common.

From-SVN: r81899

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5b764237a1f09aad23fbcea8eda6f05528204fcd..ee25a940b77b5d504235c0cba121dcea8d6eceb8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2004-05-15  Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
+
+       PR fortran/13742
+       * decl.c (add_init_expr_to_sym): Verify that COMMON variable is
+       not initialized in a disallowed fashion.
+       * match.c (gfc_match_common): Likewise.
+       (var_element): Verify that variable is not in the blank COMMON,
+       if it is in a common. 
+
 2004-05-15  Joseph S. Myers  <jsm@polyomino.org.uk>
 
        * Make-lang.in (f95.generated-manpages): Remove.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index c36c7bad51d3073e4ea18bc7606ec61df19b0638..ff87bee144aa429dc3f25fcf4ccf9a8a4db2cf2f 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -276,6 +276,15 @@ add_init_expr_to_sym (const char *name, gfc_expr ** initp,
       return FAILURE;
     }
 
+  if (attr.in_common
+      && !attr.data
+      && *initp != NULL)
+    {
+      gfc_error ("Initializer not allowed for COMMON variable '%s' at %C",
+                sym->name);
+      return FAILURE;
+    }
+
   if (init == NULL)
     {
       /* An initializer is required for PARAMETER declarations.  */

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 1b2b763013e28cbbad4ee67d698655070495d659..6c7251f05c0314aea9285f0d2004f2bb8024e52a 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2338,6 +2338,19 @@ gfc_match_common (void)
              goto cleanup;
            }
 
+         if (sym->value != NULL
+             && (common_name == NULL || !sym->attr.data))
+           {
+             if (common_name == NULL)
+               gfc_error ("Previously initialized symbol '%s' in "
+                          "blank COMMON block at %C", sym->name);
+             else
+               gfc_error ("Previously initialized symbol '%s' in "
+                          "COMMON block '%s' at %C", sym->name,
+                          common_name->name);
+             goto cleanup;
+           }
+
          if (gfc_add_in_common (&sym->attr, NULL) == FAILURE)
            goto cleanup;
 
@@ -2814,6 +2827,7 @@ static match
 var_element (gfc_data_variable * new)
 {
   match m;
+  gfc_symbol *sym, *t;
 
   memset (new, '\0', sizeof (gfc_data_variable));
 
@@ -2824,14 +2838,27 @@ var_element (gfc_data_variable * new)
   if (m != MATCH_YES)
     return m;
 
-  if (new->expr->symtree->n.sym->value != NULL)
+  sym = new->expr->symtree->n.sym;
+
+  if(sym->value != NULL)
     {
       gfc_error ("Variable '%s' at %C already has an initialization",
-                new->expr->symtree->n.sym->name);
+                sym->name);
       return MATCH_ERROR;
     }
 
-  new->expr->symtree->n.sym->attr.data = 1;
+  if (sym->attr.in_common)
+    /* See if sym is in the blank common block.  */
+    for (t = sym->ns->blank_common; t; t = t->common_next)
+      if (sym == t)
+       {
+         gfc_error ("DATA statement at %C may not initialize variable "
+                    "'%s' from blank COMMON", sym->name);
+         return MATCH_ERROR;
+       }
+
+  sym->attr.data = 1;
+
   return MATCH_YES;
 }