re PR fortran/24655 (ICE with statement function)

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

	PR fortran/24655
	PR fortran/24755
	* match.c (recursive_stmt_fcn): Add checks that symtree exists
	for the expression to weed out inline intrinsic functions and
	parameters.

	PR fortran/24409
	* module.c (mio_symtree_ref): Correct the patch of 0923 so that
	a symbol is not substituted for by a the symbol for the module
	itself and to prevent the promotion of a formal argument.

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

	PR fortran/24655
	PR fortran/24755
	* gfortran.dg/recursive_statement_functions.f90: Add statement 
	functions using inline intrinsic functions and parameters to test
	that they no longer seg-fault.

	PR fortran/24409
	gfortran.dg/nested_modules_4.f90: New test.
	gfortran.dg/nested_modules_5.f90: New test.

From-SVN: r106756

gcc/fortran/ChangeLog

+2005-11-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24655
+	PR fortran/24755
+	* match.c (recursive_stmt_fcn): Add checks that symtree exists
+	for the expression to weed out inline intrinsic functions and
+	parameters.
+
+	PR fortran/24409
+	* module.c (mio_symtree_ref): Correct the patch of 0923 so that
+	a symbol is not substituted for by a the symbol for the module
+	itself and to prevent the promotion of a formal argument.
+
 2005-11-10  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
 
 	PR fortran/24643

gcc/fortran/match.c

@@ -2723,6 +2723,9 @@ recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym)
 	    return true;
 	}
 
+      if (e->symtree == NULL)
+	return false;
+
       /* Check the name before testing for nested recursion!  */
       if (sym->name == e->symtree->n.sym->name)
 	return true;
@@ -2736,7 +2739,7 @@ recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym)
       break;
 
     case EXPR_VARIABLE:
-      if (sym->name == e->symtree->n.sym->name)
+      if (e->symtree && sym->name == e->symtree->n.sym->name)
 	return true;
       break;
 

gcc/fortran/module.c

@@ -2113,9 +2113,17 @@ mio_symtree_ref (gfc_symtree ** stp)
 	 namespace to see if the required, non-contained symbol is available
 	 yet. If so, the latter should be written.  */
       if ((*stp)->n.sym && check_unique_name((*stp)->name))
-	ns_st = gfc_find_symtree (gfc_current_ns->sym_root, (*stp)->n.sym->name);
-
-      mio_symbol_ref (ns_st ? &ns_st->n.sym : &(*stp)->n.sym);
+	ns_st = gfc_find_symtree (gfc_current_ns->sym_root,
+				    (*stp)->n.sym->name);
+
+      /* On the other hand, if the existing symbol is the module name or the
+	 new symbol is a dummy argument, do not do the promotion.  */
+      if (ns_st && ns_st->n.sym
+	    && ns_st->n.sym->attr.flavor != FL_MODULE
+	    && !(*stp)->n.sym->attr.dummy)
+	mio_symbol_ref (&ns_st->n.sym);
+      else
+	mio_symbol_ref (&(*stp)->n.sym);
     }
   else
     {

gcc/testsuite/ChangeLog

+2005-11-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24655
+	PR fortran/24755
+	* gfortran.dg/recursive_statement_functions.f90: Add statement 
+	functions using inline intrinsic functions and parameters to test
+	that they no longer seg-fault.
+
+	PR fortran/24409
+	gfortran.dg/nested_modules_4.f90: New test.
+	gfortran.dg/nested_modules_5.f90: New test.
+
 2005-11-10  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
 
 	PR fortran/24643

gcc/testsuite/gfortran.dg/nested_modules_4.f90

+! { dg-do compile }
+!
+! Test for the fix to PR24409 - the name clash between the module
+! name and the interface formal argument would cause an ICE.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module string 
+  interface
+    function  lc(string )
+      character(len=*), intent(in)  :: string 
+      character(len=len(string ))    :: lc
+    end function lc
+  end interface
+end module string
+
+module serial
+  use string
+end module serial
+
+  use serial
+  use string
+  character*15  :: buffer  
+  buffer = lc ("Have a Nice DAY")
+  end

gcc/testsuite/gfortran.dg/nested_modules_5.f90

+! { dg-do compile }
+!
+! Test for supplementary fix to PR24409 - the name clash between the module
+! variable and the interface formal argument would cause an ICE.
+!
+! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+!
+module anything 
+  interface
+    function  lc(string )
+      character(len=*), intent(in)  :: string 
+      character(len=len(string ))    :: lc
+    end function lc
+  end interface
+  character(len=12) :: string
+end module anything
+
+module serial
+  use anything
+end module serial
+
+  use serial
+  use anything
+  character*15  :: buffer  
+  buffer = lc ("Have a Nice DAY")
+  end

gcc/testsuite/gfortran.dg/recursive_statement_functions.f90

 ! { dg-do compile }
 ! PR20866 - A statement function cannot be recursive.
 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
-  INTEGER :: i, st1, st2, st3
+!
+! Modified 20051110 to check that regressions PR24655 and PR24755
+! are fixed. Thanks to pavarini@pv.infn.it and tdeutsch@cea.fr for
+! the tests.
+!
+  INTEGER :: i, st1, st2, st3, lambda, n
   REAL :: x, z(2,2)
-  character*8 :: ch
+  character(8) :: ch
+  real(8)   :: fi, arg, sigma, dshpfunc
+  real(8), parameter :: one=1d0
 !
 ! Test check for recursion via other statement functions, string
 ! length references, function actual arguments and array index
 ! references.
-  st1(i)=len(ch(st2(1):8))
-  st2(i)=max (st3(1), 4)
-  st3(i)=2 + cos (z(st1 (1), i)) ! { dg-error "is recursive" }
-  write(6,*) st1(1)
+!
+  st1 (i) = len (ch(st2 (1):8))
+  st2 (i) = max (st3 (1), 4)
+  st3 (i) = 2 + cos (z(st1 (1), i)) ! { dg-error "is recursive" }
+!
+! Test the two regressions.
+!
+  fi (n) = n *one
+  dshpfunc (arg)=-lambda/sigma*(arg/sigma)**(lambda-1)*exp(-(arg/sigma)**lambda)
+!
+! References to each statement function.
+!
+  write(6,*) st1 (1), fi (2), dshpfunc (1.0_8)
   END