re PR fortran/18878 ([4.0 only] erronous error message on vaild USE statement)

2005-09-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/18878
	* module.c (find_use_name_n): Based on original
	find_use_name. Either counts number of use names for a
	given real name or returns use name n.
	(find_use_name, number_use_names): Interfaces to the
	function find_use_name_n.
	(read_module): Add the logic and calls to these functions,
	so that mutiple reuses of the same real name are loaded.

2005-09-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/22304
	PR fortran/23270
	PR fortran/18870
	PR fortran/16511
	PR fortran/17917
	* gfortran.h: Move definition of BLANK_COMMON_NAME from trans-
	common.c so that it is accessible to module.c. Add common_head
	field to gfc_symbol structure. Add field for the equivalence
	name AND new attr field, in_equivalence.
	* match.c (gfc_match_common, gfc_match_equivalence): In loops
	that flag common block equivalences, emit an error if the
	common blocks are different, using sym->common_head as the
	common block identifier. Ensure that symbols that are equivalence
	associated with a common block are marked as being in_common.
	* module.c (write_blank_common): New.
	(write_common): Use unmangled common block name.
	(load_equiv): New function ported from g95.
	(read_module): Call load_equiv.
	(write_equiv): New function ported from g95. Correct
	string referencing for gfc functions. Give module
	equivalences a unique name.
	(write_module): Call write_equiv and write_blank_common.
	* primary.c (match_variable) Old gfc_match_variable, made
	static and third argument provided to indicate if parent
	namespace to be visited or not.
	(gfc_match_variable) New. Interface to match_variable.
	(gfc_match_equiv_variable) New. Interface to match_variable.
	* trans-common.c (finish_equivalences): Provide the call
	to create_common with a gfc_common_header so that
	module equivalences are made external, rather than local.
	(find_equivalences): Ensure that all members in common block
	equivalences are marked as used. This prevents the subsequent
	call to this function from making local unions.
	* trans-decl.c (gfc_generate_function_code): Move the call to
	gfc_generate_contained_functions to after the call to
	gfc_trans_common so the use-associated, contained common
	blocks produce the correct references.
	(gfc_create_module_variable): Return for equivalenced symbols
	with existing backend declaration.

2005-09-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/18878
	* gfortran.dg/module_double_reuse.f90: New.

2005-09-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/23270
	PR fortran/22304
	PR fortran/18870
	PR fortran/17917
	PR fortran/16511
	* gfortran.dg/common_equivalence_1.f: New.
	* gfortran.dg/common_equivalence_2.f: New.
	* gfortran.dg/common_equivalence_3.f: New.
	* gfortran.dg/contained_equivalence_1.f90: New.
	* gfortran.dg/module_blank_common.f90: New.
	* gfortran.dg/module_commons_1.f90: New.
	* gfortran.dg/module_equivalence_1.f90: New.
	* gfortran.dg/nested_modules_1.f90: New.
	* gfortran.dg/g77/19990905-0.f: Remove XFAIL, rearrange
	equivalences and add comment to connect the test with
	the PR.

From-SVN: r104060

1 files changed, 51 insertions, 36 deletions

diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index ecdfd2c..039d86d 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -119,8 +119,6 @@ typedef struct segment_info
 static segment_info * current_segment;
 static gfc_namespace *gfc_common_ns = NULL;
 
-#define BLANK_COMMON_NAME "__BLNK__"
-
 /* Make a segment_info based on a symbol.  */
 
 static segment_info *
@@ -665,46 +663,45 @@ add_condition (segment_info *f, gfc_equiv *eq1, gfc_equiv *eq2)
 
 
 /* Given a segment element, search through the equivalence lists for unused
-   conditions that involve the symbol.  Add these rules to the segment.  Only
-   checks for rules involving the first symbol in the equivalence set.  */
- 
+   conditions that involve the symbol.  Add these rules to the segment.  */
+
 static bool
 find_equivalence (segment_info *n)
 {
-  gfc_equiv *e1, *e2, *eq, *other;
+  gfc_equiv *e1, *e2, *eq;
   bool found;
- 
+
   found = FALSE;
+
   for (e1 = n->sym->ns->equiv; e1; e1 = e1->next)
     {
-      other = NULL;
-      for (e2 = e1->eq; e2; e2 = e2->eq)
-	{
-	  if (e2->used)
-	    continue;
+      eq = NULL;
 
-	  if (e1->expr->symtree->n.sym == n->sym)
-	    {
-	      eq = e1;
-	      other = e2;
-	    }
-	  else if (e2->expr->symtree->n.sym == n->sym)
+      /* Search the equivalence list, including the root (first) element
+         for the symbol that owns the segment.  */
+      for (e2 = e1; e2; e2 = e2->eq)
+	{
+	  if (!e2->used && e2->expr->symtree->n.sym == n->sym)
 	    {
 	      eq = e2;
-	      other = e1;
+	      break;
 	    }
-	  else
-	    eq = NULL;
-	  
-	  if (eq)
+	}
+
+      /* Go to the next root element.  */
+      if (eq == NULL)
+	continue;
+
+      eq->used = 1;
+
+      /* Now traverse the equivalence list matching the offsets.  */
+      for (e2 = e1; e2; e2 = e2->eq)
+	{
+	  if (!e2->used && e2 != eq)
 	    {
-	      add_condition (n, eq, other);
-	      eq->used = 1;
+	      add_condition (n, eq, e2);
+	      e2->used = 1;
 	      found = TRUE;
-	      /* If this symbol is the first in the chain we may find other
-		 matches. Otherwise we can skip to the next equivalence.  */
-	      if (eq == e2)
-		break;
 	    }
 	}
     }
@@ -813,12 +810,14 @@ translate_common (gfc_common_head *common, gfc_symbol *var_list)
   /* Add symbols to the segment.  */
   for (sym = var_list; sym; sym = sym->common_next)
     {
-      if (sym->equiv_built)
-	{
-	  /* Symbol has already been added via an equivalence.  */
-	  current_segment = common_segment;
-	  s = find_segment_info (sym);
+      current_segment = common_segment;
+      s = find_segment_info (sym);
 
+      /* Symbol has already been added via an equivalence.  Multiple
+	 use associations of the same common block result in equiv_built
+	 being set but no information about the symbol in the segment.  */
+      if (s && sym->equiv_built)
+	{
 	  /* Ensure the current location is properly aligned.  */
 	  align = TYPE_ALIGN_UNIT (s->field);
 	  current_offset = (current_offset + align - 1) &~ (align - 1);
@@ -893,6 +892,7 @@ finish_equivalences (gfc_namespace *ns)
 {
   gfc_equiv *z, *y;
   gfc_symbol *sym;
+  gfc_common_head * c;
   HOST_WIDE_INT offset;
   unsigned HOST_WIDE_INT align;
   bool dummy;
@@ -916,8 +916,23 @@ finish_equivalences (gfc_namespace *ns)
 
 	apply_segment_offset (current_segment, offset);
 
-	/* Create the decl.  */
-        create_common (NULL, current_segment, true);
+	/* Create the decl. If this is a module equivalence, it has a unique
+	   name, pointed to by z->module. This is written to a gfc_common_header
+	   to push create_common into using build_common_decl, so that the
+	   equivalence appears as an external symbol. Otherwise, a local
+	   declaration is built using build_equiv_decl.*/
+	if (z->module)
+	  {
+	    c = gfc_get_common_head ();
+	    /* We've lost the real location, so use the location of the
+	     enclosing procedure.  */
+	    c->where = ns->proc_name->declared_at;
+	    strcpy (c->name, z->module);
+	  }
+	else
+	  c = NULL;
+
+        create_common (c, current_segment, true);
         break;
       }
 }