mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-24 04:10:29 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/28890 (ICE on write)

Browse Source 
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-11  Paul Thomas  <pault@gcc.gnu.org>

	PR libfortran/28890
	gfortran.dg/assumed_charlen_function_5.f90: New test.

From-SVN: r116839
This commit is contained in:
Paul Thomas 2006-09-11 05:02:58 +00:00
parent bc70af526c
commit 7f39b34c7e
5 changed files with 83 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -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

1
gcc/fortran/resolve.c
View File

@ -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. */

32
gcc/fortran/trans-expr.c
View File

@ -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)

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2006-09-11 Paul Thomas <pault@gcc.gnu.org>
PR libfortran/28890
gfortran.dg/assumed_charlen_function_5.f90: New test.
2006-09-10 Mark Mitchell <mark@codesourcery.com>
PR c++/28991

39
gcc/testsuite/gfortran.dg/assumed_charlen_function_5.f90 Normal file
View File

@ -0,0 +1,39 @@
! { dg-do compile }
! Tests the patch for PR28890, in which a reference to a legal reference
! to an assumed character length function, passed as a dummy, would
! cause an ICE.
!
! Contributed by Paul Thomas <pault@gcc.gnu.org>
!
character(*) function charrext (n) ! { dg-warning "is obsolescent in fortran 95" }
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) ! { dg-warning "is obsolescent in fortran 95" }
character(*) :: charr
integer :: i
print *, charr(i)
ctest = 1
end function ctest
end
integer(4) function test(charr, i) ! { dg-warning "is obsolescent in fortran 95" }
character(*) :: charr
integer :: i
print *, charr(i)
test = 1
end function test