Re: [gfortran] patch was: Re: Untabified and resubmitted: Patch togfortran PR13742

[Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>]

Tobias Schlüter wrote:
> Now I'm embarassed. Looks like I messed up the check in decl.c after 
> verifying that it works ... I believe that in the version I posted the 
> error message in decl.c can never happen, and I had made sure that the 
> error triggers. The fix is to remove the check sym->value != NULL from 
> the hunk to decl.c. In order to save myself the embarassment of posting 
> another wrong patch, I would appreciate if you could check with this 
> correction, before I submit an updated patch.

This time Victor found no mistake. The only change is the one I pointed 
out above.

Compiled, tested, verified.

- Tobi

2004-05-08  Tobias Schlüter <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.

Index: match.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/match.c,v
retrieving revision 1.1.2.8
diff -u -p -r1.1.2.8 match.c
--- match.c     11 Jan 2004 15:21:50 -0000      1.1.2.8
+++ match.c     10 May 2004 17:23:51 -0000
@@ -2346,6 +2355,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;

@@ -2822,7 +2844,8 @@ static match
 var_element (gfc_data_variable * new)
 {
   match m;
-
+  gfc_symbol *sym, *t;
+
   memset (new, '\0', sizeof (gfc_data_variable));

   if (gfc_match_char ('(') == MATCH_YES)
@@ -2832,14 +2855,26 @@ 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;
 }

Index: decl.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/Attic/decl.c,v
retrieving revision 1.1.2.2
diff -u -p -r1.1.2.2 decl.c
--- decl.c      2 Aug 2003 00:26:48 -0000       1.1.2.2
+++ decl.c      10 May 2004 17:24:00 -0000
@@ -275,6 +275,15 @@ add_init_expr_to_sym (const char *name,
       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.  */