[Patch, Fortran] PR34658 - More COMMON checks

[Tobias Burnus <burnus at net-b dot de>]

Hi all,

Regarding blank commons in BLOCK DATA: I believe the following program
is valid Fortran 95 and Fortran 2003, but gfortran currently gives
"Warning: BLOCK DATA unit cannot contain blank COMMON at (1)" for:

block data bd
 integer :: i
 common //i
end block data bd

I agree that the program is invalid as soon as "i" is initialized (e.g.
"data i/5/"). NAG f95 gives a similar warning ("Warning: Blank common
appears in BLOCK DATA BD"), but both do not check whether "i" is
initialized. By comparison, g95 gives an error if "i" is initialized,
but not if a not-initialized variable is used in a blank common.

Fortran 95 ("11.4 Block data program units"): "Only an object in a named
common block may be initially defined in a block data program unit."

Fortran 2003 ("11.3 Block data program units"): "Only an object in a
named common block may be initially defined in a block data program unit."

(Note: "defined" != "specified"; "defined (2.5.5): For a data object,
the property of having or being given a valid value.")

On the other hand, one can argue that having COMMON blocks without
initialization defeeds the purpose of block data: "A block data program
unit is used to provide initial values for data objects in named common
blocks." Nonetheless, I believe such programs are valid.

Therefore, I think the warning can be completely removed, which I did.
One could also downgrade the warning to -Wsurprising, if someone thinks
that is a better solution. See also PR 29537 which introduced this
warning. Comments?

 * * *

The resolve.c part of the patch should be uncontroversial. It does:

- Check also constrains for blank commons

- Reject (with -std=f2003) initialized variables outside BLOCK DATA and
in BLOCK DATA initialized variables in blank commons.

Currently, only with -std=f95 the program is rejected, one could also
follow g95 and NAG f95 and emit always an error. ifort (without -stand
f95) allows such programs, however.

Build and regtested on x86-64-linux; I get an ICE for common_6.f90 now
also for -m32, but this is already tracked as PR33375.
OK for the trunk?

Tobias

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.

Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 131350)
+++ gcc/fortran/match.c	(working copy)
@@ -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;
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 131350)
+++ gcc/fortran/resolve.c	(working copy)
@@ -646,23 +647,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 +685,23 @@ resolve_common_blocks (gfc_symtree *comm
 		       "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)
@@ -8931,6 +8957,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);
Index: gcc/testsuite/gfortran.dg/common_11.f90
===================================================================
--- gcc/testsuite/gfortran.dg/common_11.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/common_11.f90	(revision 0)
@@ -0,0 +1,30 @@
+! { 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
Index: gcc/testsuite/gfortran.dg/blockdata_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/blockdata_1.f90	(revision 131350)
+++ gcc/testsuite/gfortran.dg/blockdata_1.f90	(working copy)
@@ -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
 !