re PR fortran/34658 (save / common)

2007-01-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34658
        * match.c (gfc_match_common): Remove blank common in
        DATA BLOCK warning.
        * resolve.c (resolve_common_vars): New function.
        (resolve_common_blocks): Move checks to resolve_common_vars
        and invoke that function.
        (resolve_types): Call resolve_common_vars for blank commons.

2007-01-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34658
        * gfortran.dg/common_11.f90: New.
        * gfortran.dg/blockdata_1.f90: Update test case.
        * gfortran.dg/blockdata_2.f90: Update test case.

From-SVN: r131355

gcc/fortran/ChangeLog

+2007-01-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34658
+	* match.c (gfc_match_common): Remove blank common in
+	DATA BLOCK warning.
+	* resolve.c (resolve_common_vars): New function.
+	(resolve_common_blocks): Move checks to resolve_common_vars
+	and invoke that function.
+	(resolve_types): Call resolve_common_vars for blank commons.
+
 2008-01-06  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/34655

gcc/fortran/match.c

@@ -2784,11 +2784,6 @@ gfc_match_common (void)
 
       if (name[0] == '\0')
 	{
-	  if (gfc_current_ns->is_block_data)
-	    {
-	      gfc_warning ("BLOCK DATA unit cannot contain blank COMMON "
-			   "at %C");
-	    }
 	  t = &gfc_current_ns->blank_common;
 	  if (t->head == NULL)
 	    t->where = gfc_current_locus;

gcc/fortran/resolve.c

@@ -646,23 +646,27 @@ has_default_initializer (gfc_symbol *der)
   return c != NULL;
 }
 
-
-/* Resolve common blocks.  */
+/* Resolve common variables.  */
 static void
-resolve_common_blocks (gfc_symtree *common_root)
+resolve_common_vars (gfc_symbol *sym, bool named_common)
 {
-  gfc_symbol *sym, *csym;
-
-  if (common_root == NULL)
-    return;
+  gfc_symbol *csym = sym;
 
-  if (common_root->left)
-    resolve_common_blocks (common_root->left);
-  if (common_root->right)
-    resolve_common_blocks (common_root->right);
-
-  for (csym = common_root->n.common->head; csym; csym = csym->common_next)
+  for (; csym; csym = csym->common_next)
     {
+      if (csym->value || csym->attr.data)
+	{
+	  if (!csym->ns->is_block_data)
+	    gfc_notify_std (GFC_STD_GNU, "Variable '%s' at %L is in COMMON "
+			    "but only in BLOCK DATA initialization is "
+			    "allowed", csym->name, &csym->declared_at);
+	  else if (!named_common)
+	    gfc_notify_std (GFC_STD_GNU, "Initialized variable '%s' at %L is "
+			    "in a blank COMMON but initialization is only "
+			    "allowed in named common blocks", csym->name,
+			    &csym->declared_at);
+	}
+
       if (csym->ts.type != BT_DERIVED)
 	continue;
 
@@ -680,6 +684,23 @@ resolve_common_blocks (gfc_symtree *common_root)
 		       "may not have default initializer", csym->name,
 		       &csym->declared_at);
     }
+}
+
+/* Resolve common blocks.  */
+static void
+resolve_common_blocks (gfc_symtree *common_root)
+{
+  gfc_symbol *sym;
+
+  if (common_root == NULL)
+    return;
+
+  if (common_root->left)
+    resolve_common_blocks (common_root->left);
+  if (common_root->right)
+    resolve_common_blocks (common_root->right);
+
+  resolve_common_vars (common_root->n.common->head, true);
 
   gfc_find_symbol (common_root->name, gfc_current_ns, 0, &sym);
   if (sym == NULL)
@@ -8939,6 +8960,7 @@ resolve_types (gfc_namespace *ns)
 
   resolve_entries (ns);
 
+  resolve_common_vars (ns->blank_common.head, false);
   resolve_common_blocks (ns->common_root);
 
   resolve_contained_functions (ns);

gcc/testsuite/ChangeLog

+2007-01-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34658
+	* gfortran.dg/common_11.f90: New.
+	* gfortran.dg/blockdata_1.f90: Update test case.
+	* gfortran.dg/blockdata_2.f90: Update test case.
+
 2008-01-06  Tobias Burnus  <burnus@net-b.de>
 
 	* gfortran.dg/equiv_constraint_9.f90: Fix typo.

gcc/testsuite/gfortran.dg/blockdata_1.f90

@@ -14,7 +14,7 @@ end blockdata d1
 
 block data d2
  common /b/ u
- common j ! { dg-warning "cannot contain blank COMMON" }
+ common j ! { dg-warning "blank COMMON but initialization is only allowed in named common" }
  data j /1/
 end block data d2
 !

gcc/testsuite/gfortran.dg/blockdata_2.f90

@@ -3,6 +3,6 @@
 ! proc_name from an unnamed block data which we intended to use as locus
 ! for a blank common.
 block data
-  common c ! { dg-warning "cannot contain blank COMMON" }
+  common c
 end !block data
 end

gcc/testsuite/gfortran.dg/common_11.f90

+! { dg-do compile }
+!
+! PR fortran/34658
+!
+! Check for more COMMON constrains
+!
+block data
+  implicit none
+  integer :: x, a  ! { dg-warning "Initialized variable 'a' at .1. is in a blank COMMON" }
+  integer :: y = 5, b = 5 ! { dg-warning "Initialized variable 'b' at .1. is in a blank COMMON" }
+  data x/5/, a/5/
+  common // a, b
+  common /a/ x, y
+end block data
+
+subroutine foo()
+  implicit none
+  type t
+    sequence
+    integer :: i = 5
+  end type t
+  type(t) x ! { dg-error "may not have default initializer" }
+  common // x
+end subroutine foo
+
+program test
+  implicit none
+  common /a/ I ! { dg-warning "in COMMON but only in BLOCK DATA initialization" }
+  integer :: I = 43
+end program test