From 7f39b34c7e9dfb658cad14ba0f2e2837cda695cb Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 11 Sep 2006 05:02:58 +0000 Subject: re PR fortran/28890 (ICE on write) 2006-09-11 Paul Thomas 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-11 Paul Thomas PR libfortran/28890 gfortran.dg/assumed_charlen_function_5.f90: New test. From-SVN: r116839 --- gcc/fortran/trans-expr.c | 32 ++++++++++++++++++++++++++------ 1 file changed, 26 insertions(+), 6 deletions(-) (limited to 'gcc/fortran/trans-expr.c') diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 37bf782..dc5ac27 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) -- cgit v1.1