From 9ebe2d22e7201bca8e75111ec66ccae8454896ae Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 15 Jan 2007 08:16:17 +0000 Subject: re PR fortran/28172 ([4.2 and 4.1 only] alternate return in contained procedure segfaults) 2007-01-15 Paul Thomas 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 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 --- gcc/fortran/resolve.c | 28 +++++++++++++++++++++++++--- 1 file changed, 25 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/resolve.c') 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; } -- cgit v1.1