This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [Patch, fortran] PR28923, PR28959 and PR28947 - essential fixes for the 4.2.0 release
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- Cc: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, patch <gcc-patches at gcc dot gnu dot org>, jvdelisle at gcc dot gnu dot org
- Date: Sat, 09 Sep 2006 21:41:43 +0200
- Subject: Re: [Patch, fortran] PR28923, PR28959 and PR28947 - essential fixes for the 4.2.0 release
- References: <4502B412.1050505@wanadoo.fr> <20060909181824.GA92039@troutmask.apl.washington.edu>
Steve,
PPS If people are sufficiently exercised by it for the release, I also
have a patch for PR28890 that could be fielded very quickly.
Send me the patch.
With the enclosed patch, this works and nothing is broken:
character(*) function charrext (n)
character(26) :: alpha ="abcdefghijklmnopqrstuvwxyz"
charrext = alpha (1:n)
end function charrext
character(26), external :: charrext
interface
integer*4 function test(charr, i)
character(*), external :: charr
integer :: i
end function test
end interface
do j = 1 , 26
m = test (charrext, j)
m = ctest (charrext, 27 - j)
end do
contains
integer*4 function ctest(charr, i)
character(*) :: charr
integer :: i
print *, charr(i)
ctest = 1
end function ctest
end
integer*4 function test(charr, i)
character(*) :: charr
integer :: i
print *, charr(i)
test = 1
end function test
It can be turned into a patch very quickly!
Paul
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (révision 116559)
--- gcc/fortran/trans-expr.c (copie de travail)
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 2024,2029 ****
--- 2024,2039 ----
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)
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 2040,2051 ****
{
/* 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
! {
/* Calculate the length of the returned string. */
gfc_init_se (&parmse, NULL);
if (need_interface_mapping)
--- 2050,2071 ----
{
/* 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?) 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)
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (révision 116559)
--- gcc/fortran/resolve.c (copie de travail)
*************** resolve_function (gfc_expr * expr)
*** 1413,1418 ****
--- 1413,1419 ----
&& 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. */