diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 1 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 32 |
3 files changed, 39 insertions, 6 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 159b4d13a49..b89e0c715fd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2006-09-11 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/28890 + trans-expr.c (gfc_conv_function_call): Obtain the string length + of a dummy character(*) function from the symbol if it is not + already translated. For a call to a character(*) function, use + the passed, hidden string length argument, which is available + from the backend_decl of the formal argument. + resolve.c (resolve_function): It is an error if a function call + to a character(*) function is other than a dummy procedure or + an intrinsic. + 2006-09-10 Paul Thomas <pault@gcc.gnu.org> PR fortran/28959 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b62a0411e9d..c9475cceab8 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1413,6 +1413,7 @@ resolve_function (gfc_expr * expr) && sym->ts.cl && sym->ts.cl->length == NULL && !sym->attr.dummy + && expr->value.function.esym == NULL && !sym->attr.contained) { /* Internal procedures are taken care of in resolve_contained_fntype. */ diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 37bf782f7bd..dc5ac27b786 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2030,6 +2030,16 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, gfc_add_expr_to_block (&se->pre, tmp); } + if (fsym && fsym->ts.type == BT_CHARACTER + && parmse.string_length == NULL_TREE + && e->ts.type == BT_PROCEDURE + && e->symtree->n.sym->ts.type == BT_CHARACTER + && e->symtree->n.sym->ts.cl->length != NULL) + { + gfc_conv_const_charlen (e->symtree->n.sym->ts.cl); + parmse.string_length = e->symtree->n.sym->ts.cl->backend_decl; + } + /* Character strings are passed as two parameters, a length and a pointer. */ if (parmse.string_length != NULL_TREE) @@ -2046,12 +2056,22 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, { /* Assumed character length results are not allowed by 5.1.1.5 of the standard and are trapped in resolve.c; except in the case of SPREAD - (and other intrinsics?). In this case, we take the character length - of the first argument for the result. */ - cl.backend_decl = TREE_VALUE (stringargs); - } - else - { + (and other intrinsics?) and dummy functions. In the case of SPREAD, + we take the character length of the first argument for the result. + For dummies, we have to look through the formal argument list for + this function and use the character length found there.*/ + if (!sym->attr.dummy) + cl.backend_decl = TREE_VALUE (stringargs); + else + { + formal = sym->ns->proc_name->formal; + for (; formal; formal = formal->next) + if (strcmp (formal->sym->name, sym->name) == 0) + cl.backend_decl = formal->sym->ts.cl->backend_decl; + } + } + else + { /* Calculate the length of the returned string. */ gfc_init_se (&parmse, NULL); if (need_interface_mapping) |
