re PR fortran/28172 ([4.2 and 4.1 only] alternate return in contained procedure segfaults)

2007-01-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28172
	* trans-stmt.c (gfc_trans_call): If it does not have one, get
	a backend_decl for an alternate return.

	PR fortran/29389
	* resolve.c (pure_function): Statement functions are pure. Note
	that this will have to recurse to comply fully with F95.

	PR fortran/29712
	* resolve.c (resolve_function): Only a reference to the final
	dimension of an assumed size array is an error in an inquiry
	function.

	PR fortran/30283
	* resolve.c (resolve_function): Make sure that the function
	expression has a type.

2007-01-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28172
	* gfortran.dg/altreturn_4.f90: New test.

	PR fortran/29389
	* gfortran.dg/stfunc_4.f90: New test.

	PR fortran/29712
	* gfortran.dg/bound_2.f90: Reinstate commented out line.
	* gfortran.dg/initialization_1.f90: Change warning.

	PR fortran/30283
	* gfortran.dg/specification_type_resolution_2.f90: New test.

From-SVN: r120790

3 files changed, 46 insertions, 3 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5c8567b..d88fa83 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,22 @@
+2007-01-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28172
+	* trans-stmt.c (gfc_trans_call): If it does not have one, get
+	a backend_decl for an alternate return.
+
+	PR fortran/29389
+	* resolve.c (pure_function): Statement functions are pure. Note
+	that this will have to recurse to comply fully with F95.
+
+	PR fortran/29712
+	* resolve.c (resolve_function): Only a reference to the final
+	dimension of an assumed size array is an error in an inquiry
+	function.
+
+	PR fortran/30283
+	* resolve.c (resolve_function): Make sure that the function
+	expression has a type.
+
 2007-01-14  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/30410
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 05b4dc1..59adf8b 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1501,6 +1501,11 @@ pure_function (gfc_expr * e, const char **name)
 {
   int pure;
 
+  if (e->symtree != NULL
+        && e->symtree->n.sym != NULL
+        && e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION)
+    return 1;
+
   if (e->value.function.esym)
     {
       pure = gfc_pure (e->value.function.esym);
@@ -1654,9 +1659,15 @@ resolve_function (gfc_expr * expr)
 
       for (arg = expr->value.function.actual; arg; arg = arg->next)
 	{
-	  if (inquiry && arg->next != NULL && arg->next->expr
-		&& arg->next->expr->expr_type != EXPR_CONSTANT)
-	    break;
+	  if (inquiry && arg->next != NULL && arg->next->expr)
+	    {
+	      if (arg->next->expr->expr_type != EXPR_CONSTANT)
+		break;
+
+	      if ((int)mpz_get_si (arg->next->expr->value.integer)
+			< arg->expr->rank)
+		break;
+	    }
 
 	  if (arg->expr != NULL
 		&& arg->expr->rank > 0
@@ -1723,6 +1734,17 @@ resolve_function (gfc_expr * expr)
   if (t == SUCCESS)
     find_noncopying_intrinsics (expr->value.function.esym,
 				expr->value.function.actual);
+
+  /* Make sure that the expression has a typespec that works.  */
+  if (expr->ts.type == BT_UNKNOWN)
+    {
+      if (expr->symtree->n.sym->result
+	    && expr->symtree->n.sym->result->ts.type != BT_UNKNOWN)
+	expr->ts = expr->symtree->n.sym->result->ts;
+      else
+	expr->ts = expr->symtree->n.sym->result->ts;
+    }
+
   return t;
 }
 
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 3c14d02..ed37272 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -349,6 +349,8 @@ gfc_trans_call (gfc_code * code, bool dependency_check)
 	  gcc_assert(select_code->op == EXEC_SELECT);
 	  sym = select_code->expr->symtree->n.sym;
 	  se.expr = convert (gfc_typenode_for_spec (&sym->ts), se.expr);
+	  if (sym->backend_decl == NULL)
+	    sym->backend_decl = gfc_get_symbol_decl (sym);
 	  gfc_add_modify_expr (&se.pre, sym->backend_decl, se.expr);
 	}
       else