diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2007-01-15 08:16:17 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2007-01-15 08:16:17 +0000 |
| commit | 9ebe2d22e7201bca8e75111ec66ccae8454896ae (patch) | |
| tree | a550028d50f83d692906ac5ccf4710e018f70359 /gcc/fortran/resolve.c | |
| parent | 32d6b8aef41aa68e506f2e66ca10b1fdafbb3aaf (diff) | |
| download | gcc-9ebe2d22e7201bca8e75111ec66ccae8454896ae.zip gcc-9ebe2d22e7201bca8e75111ec66ccae8454896ae.tar.gz gcc-9ebe2d22e7201bca8e75111ec66ccae8454896ae.tar.bz2 | |
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
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 28 |
1 files changed, 25 insertions, 3 deletions
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; } |