[Patch, Fortran] PR 25062 Common block name shall conflict with parameters and intrinsic procedures

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

:ADDPATCH fortran:

! F2003: 16.2.1
! "A name that identifies a common block in a scoping unit shall not be used
!  to identify a constant or an intrinsic procedure in that scoping unit. If
!  a local identifier is also the name of a common block, the appearance of
!  that name in any context other than as a common block name in a COMMON
!  or SAVE statement is an appearance of the local identifier."


gfortran did not honour that the common block name conflicts with a
constant or an intrinsic procedure.


Fortran 95 was stricter in this regard:

! F95: 14.1.2.1:
! "A common block name in a scoping unit also may be the name of any local
!  entity other than a named constant, intrinsic procedure, or a local variable
!  that is also an external function in a function subprogram."


I added the checks needed for the Fortran 95 contrains as well, however,
they are never reached as match.c's gfc_match_common blocks those too
early (-> PR32515).

Could someone help me with the standard? Should the following be
rejected in F95 or not? NAG f95 and g95 do:

function func1() result(res)
  real res, r
  common /res/ r
! this is actually not found by gfc_match_common; see common_9.f90

function func2()
  real func2, r
  common /func2/ r

I currently reject it as well.

Build & regression tested on x86-64. Ok for the trunk?

Tobias

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

	PR fortran/25062
	* resolve.c (resolve_common_blocks): New check function.
	(resolve_types): Use it.

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

	PR fortran/25062
	* common_7.f90: New.
	* common_8.f90: New.
	* common_9.f90: New.

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 126029)
+++ gcc/fortran/resolve.c	(working copy)
@@ -594,6 +594,56 @@ resolve_entries (gfc_namespace *ns)
 }
 
 
+/* Resolve common blocks.  */
+static void
+resolve_common_blocks (gfc_symtree *common_root)
+{
+   gfc_symtree *symtree;
+   gfc_symbol *sym;
+
+   if (common_root == NULL)
+     return;
+
+   for (symtree = common_root; symtree->left; symtree = symtree->left);
+
+   for (; symtree; symtree = symtree->right)
+     {
+	gfc_find_symbol (symtree->name, gfc_current_ns, 0, &sym);
+	if (sym == NULL)
+	  continue;
+
+	if (sym->attr.flavor == FL_PARAMETER)
+	  {
+	    gfc_error ("COMMON block '%s' at %L is used as PARAMETER at %L",
+		       sym->name, &symtree->n.common->where,
+		       &sym->declared_at);
+	  }
+
+	if (sym->attr.intrinsic)
+	  {
+	    gfc_error ("COMMON block '%s' at %L is also an intrinsic "
+		       "procedure", sym->name,
+		       &symtree->n.common->where);
+	  }
+	else if (sym->attr.result
+		 ||(sym->attr.function && gfc_current_ns->proc_name == sym))
+	  {
+	    gfc_notify_std (GFC_STD_F2003, "Fortran 2003: COMMON block '%s' "
+			    "at %L that is also a function result", sym->name,
+			    &symtree->n.common->where);
+	  }
+	else if (sym->attr.flavor == FL_PROCEDURE
+		&& sym->attr.proc != PROC_INTERNAL
+		&& sym->attr.proc != PROC_ST_FUNCTION)
+	  {
+	    gfc_notify_std (GFC_STD_F2003, "Fortran 2003: COMMON block '%s' "
+			    "at %L that is also a global procedure", sym->name,
+			    &symtree->n.common->where);
+	  }
+     }
+}
+
+
 /* Resolve contained function types.  Because contained functions can call one
    another, they have to be worked out before any of the contained procedures
    can be resolved.
@@ -7402,6 +7452,8 @@ resolve_types (gfc_namespace *ns)
 
   resolve_entries (ns);
 
+  resolve_common_blocks (ns->common_root);
+
   resolve_contained_functions (ns);
 
   for (cl = ns->cl_list; cl; cl = cl->next)
Index: gcc/testsuite/gfortran.dg/common_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/common_7.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/common_7.f90	(revision 0)
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! F2003: 16.2.1
+! "A name that identifies a common block in a scoping unit shall not be used 
+!  to identify a constant or an intrinsic procedure in that scoping unit."
+!
+subroutine x134
+ INTEGER, PARAMETER ::  C1=1  ! { dg-error "COMMON block 'c1' at \\(1\\) is used as PARAMETER" } 
+ COMMON /C1/ I  ! { dg-error "COMMON block 'c1' at \\(1\\) is used as PARAMETER" } 
+end subroutine
+end
Index: gcc/testsuite/gfortran.dg/common_8.f90
===================================================================
--- gcc/testsuite/gfortran.dg/common_8.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/common_8.f90	(revision 0)
@@ -0,0 +1,32 @@
+! { dg-do compile }
+!
+! PR fortran/25062
+!
+! F2003: 16.2.1
+! "A name that identifies a common block in a scoping unit shall not be used 
+!  to identify a constant or an intrinsic procedure in that scoping unit."
+!
+subroutine try
+ implicit none
+ COMMON /s/ J
+ COMMON /bar/ I
+ INTEGER I, J
+ real s, x
+ s(x)=sin(x)
+ print *, s(5.0)
+ call bar()
+contains
+ subroutine bar
+   print *, 'Hello world'
+ end subroutine bar
+
+end subroutine try
+
+program test
+ implicit none
+ COMMON /abs/ J ! { dg-error "is also an intrinsic procedure" }
+ intrinsic :: abs
+ INTEGER J
+ external try
+ call try
+end program test
Index: gcc/testsuite/gfortran.dg/common_9.f90
===================================================================
--- gcc/testsuite/gfortran.dg/common_9.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/common_9.f90	(revision 0)
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+
+! PR fortran/25062
+!
+! F95: 14.1.2.1:
+! "A common block name in a scoping unit also may be the name of any local
+!  entity other than a named constant, intrinsic procedure, or a local variable
+!  that is also an external function in a function subprogram."
+!
+! F2003: 16.2.1
+! "A name that identifies a common block in a scoping unit shall not be used 
+!  to identify a constant or an intrinsic procedure in that scoping unit. If
+!  a local identifier is also the name of a common block, the appearance of
+!  that name in any context other than as a common block name in a COMMON
+!  or SAVE statement is an appearance of the local identifier."
+!
+function func1() result(res)
+  implicit none
+  real res, r
+  common /res/ r ! { dg-error "is also a function result" }
+end function func1
+end