re PR fortran/34975 (Bogus error with USEing modules)

2008-01-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34975
	* symbol.c (gfc_delete_symtree, gfc_undo_symbols): Rename
	delete_symtree to gfc_delete_symtree.
	* gfortran.h : Add prototype for gfc_delete_symtree.
	* module.c (load_generic_interfaces): Transfer symbol to a
	unique symtree and delete old symtree, instead of renaming.
	(read_module): The rsym and the found symbol are the same, so
	the found symtree can be deleted.

	PR fortran/34429
	* decl.c (match_char_spec): Remove the constraint on deferred
	matching of functions and free the length expression.
	delete_symtree to gfc_delete_symtree.
	(gfc_match_type_spec): Whitespace.
	(gfc_match_function_decl): Defer characteristic association for
	all types except BT_UNKNOWN.
	* parse.c (decode_specification_statement): Only derived type
	function matching is delayed to the end of specification.

2008-01-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34975
	* gfortran.dg/use_only_3.f90: New test.
	* gfortran.dg/use_only_3.inc: Modules for new test.

	PR fortran/34429
	* gfortran.dg/function_charlen_2.f90: New test.

From-SVN: r131956

gcc/fortran/ChangeLog

+2008-01-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34975
+	* symbol.c (gfc_delete_symtree, gfc_undo_symbols): Rename
+	delete_symtree to gfc_delete_symtree.
+	* gfortran.h : Add prototype for gfc_delete_symtree.
+	* module.c (load_generic_interfaces): Transfer symbol to a
+	unique symtree and delete old symtree, instead of renaming.
+	(read_module): The rsym and the found symbol are the same, so
+	the found symtree can be deleted.
+
+	PR fortran/34429
+	* decl.c (match_char_spec): Remove the constraint on deferred
+	matching of functions and free the length expression.
+	delete_symtree to gfc_delete_symtree.
+	(gfc_match_type_spec): Whitespace.
+	(gfc_match_function_decl): Defer characteristic association for
+	all types except BT_UNKNOWN.
+	* parse.c (decode_specification_statement): Only derived type
+	function matching is delayed to the end of specification.
+
 2008-01-28  Tobias Burnus  <burnus@net-b.de>
 
 	PR libfortran/34980

gcc/fortran/decl.c

@@ -2151,13 +2151,10 @@ syntax:
   return m;
 
 done:
-  /* Except in the case of the length being a function, where symbol
-     association looks after itself, deal with character functions
-     after the specification statements.  */
-  if (gfc_matching_function
-	&& !(len && len->expr_type != EXPR_VARIABLE
-		 && len->expr_type != EXPR_OP))
+  /* Deal with character functions after USE and IMPORT statements.  */
+  if (gfc_matching_function)
     {
+      gfc_free_expr (len);
       gfc_undo_symbols ();
       return MATCH_YES;
     }
@@ -2222,8 +2219,8 @@ gfc_match_type_spec (gfc_typespec *ts, int implicit_flag)
   /* A belt and braces check that the typespec is correctly being treated
      as a deferred characteristic association.  */
   seen_deferred_kind = (gfc_current_state () == COMP_FUNCTION)
-					&& (gfc_current_block ()->result->ts.kind == -1)
-					&& (ts->kind == -1);
+			  && (gfc_current_block ()->result->ts.kind == -1)
+			  && (ts->kind == -1);
   gfc_clear_ts (ts);
   if (seen_deferred_kind)
     ts->kind = -1;
@@ -4358,21 +4355,13 @@ gfc_match_function_decl (void)
 	  goto cleanup;
 	}
 
-      /* Except in the case of a function valued character length,
-	 delay matching the function characteristics until after the
+      /* Delay matching the function characteristics until after the
 	 specification block by signalling kind=-1.  */
-      if (!(current_ts.type == BT_CHARACTER
-	      && current_ts.cl
-	      && current_ts.cl->length
-	      && current_ts.cl->length->expr_type != EXPR_OP
-	      && current_ts.cl->length->expr_type != EXPR_VARIABLE))
-	{
-	  sym->declared_at = old_loc;
-	  if (current_ts.type != BT_UNKNOWN)
-	    current_ts.kind = -1;
-	  else
-	    current_ts.kind = 0;
-	}
+      sym->declared_at = old_loc;
+      if (current_ts.type != BT_UNKNOWN)
+	current_ts.kind = -1;
+      else
+	current_ts.kind = 0;
 
       if (result == NULL)
 	{

gcc/fortran/gfortran.h

@@ -2113,6 +2113,7 @@ gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
 gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
 gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
 gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
+void gfc_delete_symtree (gfc_symtree **, const char *);
 gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
 gfc_user_op *gfc_get_uop (const char *);
 gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);

gcc/fortran/module.c

@@ -3308,13 +3308,19 @@ load_generic_interfaces (void)
 
 	  if (!sym)
 	    {
-	      /* Make symtree inaccessible by renaming if the symbol has
-		 been added by a USE statement without an ONLY(11.3.2).  */
+	      /* Make the symbol inaccessible if it has been added by a USE
+		 statement without an ONLY(11.3.2).  */
 	      if (st && only_flag
 		     && !st->n.sym->attr.use_only
 		     && !st->n.sym->attr.use_rename
 		     && strcmp (st->n.sym->module, module_name) == 0)
-		st->name = gfc_get_string ("hidden.%s", name);
+		{
+		  sym = st->n.sym;
+		  gfc_delete_symtree (&gfc_current_ns->sym_root, name);
+		  st = gfc_get_unique_symtree (gfc_current_ns);
+		  st->n.sym = sym;
+		  sym = NULL;
+		}
 	      else if (st)
 		{
 		  sym = st->n.sym;
@@ -3733,21 +3739,21 @@ read_module (void)
 	    {
 	      st = gfc_find_symtree (gfc_current_ns->sym_root, name);
 
-	      /* Make symtree inaccessible by renaming if the symbol has
-		 been added by a USE statement without an ONLY(11.3.2).  */
+	      /* Delete the symtree if the symbol has been added by a USE
+		 statement without an ONLY(11.3.2). Remember that the rsym
+		 will be the same as the symbol found in the symtree, for
+		 this case.*/
 	      if (st && (only_flag || info->u.rsym.renamed)
 		     && !st->n.sym->attr.use_only
 		     && !st->n.sym->attr.use_rename
-		     && st->n.sym->module
-		     && strcmp (st->n.sym->module, module_name) == 0)
-		st->name = gfc_get_string ("hidden.%s", name);
+		     && info->u.rsym.sym == st->n.sym)
+		gfc_delete_symtree (&gfc_current_ns->sym_root, name);
 
 	      /* Create a symtree node in the current namespace for this
 		 symbol.  */
 	      st = check_unique_name (p)
 		   ? gfc_get_unique_symtree (gfc_current_ns)
 		   : gfc_new_symtree (&gfc_current_ns->sym_root, p);
-
 	      st->ambiguous = ambiguous;
 
 	      sym = info->u.rsym.sym;

gcc/fortran/parse.c

@@ -110,7 +110,7 @@ decode_specification_statement (void)
   match ("import", gfc_match_import, ST_IMPORT);
   match ("use", gfc_match_use, ST_USE);
 
-  if (gfc_numeric_ts (&gfc_current_block ()->ts))
+  if (gfc_current_block ()->ts.type != BT_DERIVED)
     goto end_of_block;
 
   match (NULL, gfc_match_st_function, ST_STATEMENT_FUNCTION);

gcc/fortran/symbol.c

@@ -2153,8 +2153,8 @@ gfc_new_symtree (gfc_symtree **root, const char *name)
 
 /* Delete a symbol from the tree.  Does not free the symbol itself!  */
 
-static void
-delete_symtree (gfc_symtree **root, const char *name)
+void
+gfc_delete_symtree (gfc_symtree **root, const char *name)
 {
   gfc_symtree st, *st0;
 
@@ -2609,7 +2609,7 @@ gfc_undo_symbols (void)
 		}
 	    }
 
-	  delete_symtree (&p->ns->sym_root, p->name);
+	  gfc_delete_symtree (&p->ns->sym_root, p->name);
 
 	  p->refs--;
 	  if (p->refs < 0)

gcc/testsuite/ChangeLog

+2008-01-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34975
+	* gfortran.dg/use_only_3.f90: New test.
+	* gfortran.dg/use_only_3.inc: Modules for new test.
+
+	PR fortran/34429
+	* gfortran.dg/function_charlen_2.f90: New test.
+
 2008-01-30  Jakub Jelinek  <jakub@redhat.com>
 
 	PR middle-end/34969

gcc/testsuite/gfortran.dg/function_charlen_2.f90

+! { dg-do compile }
+! Tests the fix for PR34429 in which function charlens that were
+! USE associated would cause an error.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m
+  integer, parameter :: l = 2
+  character(2) :: cl
+end module m
+
+program test
+  implicit none
+  integer, parameter :: l = 5
+  character(len = 10) :: c
+  character(4) :: cl
+  c = f ()
+  if (g () /= "2") call abort
+contains
+  character(len = l) function f ()
+    use m
+    if (len (f) /= 2) call abort
+    f = "a"
+  end function f
+  character(len = len (cl)) function g ()
+    use m
+    g = "4"
+    if (len (g) == 2) g= "2"
+  end function g
+end program test
+! { dg-final { cleanup-modules "m" } }

gcc/testsuite/gfortran.dg/use_only_3.f90

+! { dg-do compile }
+! This tests the patch for PR34975, in which 'n', 'ipol', and 'i' would be
+! determined to have 'no IMPLICIT type'.  It turned out to be fiendishly
+! difficult to write a testcase for this PR because even the smallest changes
+! would make the bug disappear.  This is the testcase provided in the PR, except
+! that all the modules are put in 'use_only_3.inc' in the same order as the
+! makefile.  Even this has an effect; only 'n' is now determined to be
+! improperly typed.  All this is due to the richness of the symtree and the
+! way in which the renaming inserted new symtree entries.  Unless somenody can
+! come up with a reduced version, this relatively large file will have to be added
+! to the testsuite.  Fortunately, it only has to be comiled once:)
+!  
+! Reported by Tobias Burnus <burnus@gcc.gnu.org>
+!
+include 'use_only_3.inc'
+subroutine dforceb(c0, i, betae, ipol, bec0, ctabin, gqq, gqqm, qmat, dq2, df)
+  use gvecs
+  use gvecw, only: ngw
+  use parameters
+  use electrons_base, only: nx => nbspx, n => nbsp, nspin, f
+  use constants
+  use cvan
+  use ions_base
+  use ions_base, only : nas => nax
+  implicit none
+
+  integer ipol, i, ctabin
+  complex c0(n), betae, df,&
+       &   gqq,gqqm,&
+       &   qmat
+  real bec0,&
+       &   dq2,  gmes
+
+ end subroutine dforceb
+! { dg-final { cleanup-modules "cell_base cvan gvecs kinds" } }
+! { dg-final { cleanup-modules "constants electrons_base gvecw parameters" } }
+! { dg-final { cleanup-modules "control_flags electrons_nose ions_base" } }
+