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

3 files changed, 48 insertions, 3 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5b76423..ee25a94 100644
--- 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 c36c7ba..ff87bee 100644
--- 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 1b2b763..6c7251f 100644
--- 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;
 }