git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/28118 (ICE calling subroutine defined via explicit interface) 

2006-06-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28118
	* trans-array.c (gfc_conv_expr_descriptor): When building temp,
	use the substring reference to calculate the length if the
	expression does not have a charlen.

2006-06-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28118
	* gfortran.dg/actual_array_substr_1.f90: New test.

From-SVN: r114964
This commit is contained in:
Paul Thomas 2006-06-24 13:04:37 +00:00
parent 61c25908fd
commit 32fdfa2dfa
4 changed files with 65 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
2006-06-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/28118
* trans-array.c (gfc_conv_expr_descriptor): When building temp,
use the substring reference to calculate the length if the
expression does not have a charlen.
2006-06-24 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/28094

34
gcc/fortran/trans-array.c
View File

@ -4184,9 +4184,37 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
loop.temp_ss->next = gfc_ss_terminator;
if (expr->ts.type == BT_CHARACTER)
{
if (expr->ts.cl
&& expr->ts.cl->length
&& expr->ts.cl->length->expr_type == EXPR_CONSTANT)
if (expr->ts.cl == NULL)
{
/* This had better be a substring reference! */
gfc_ref *char_ref = expr->ref;
for (; char_ref; char_ref = char_ref->next)
if (char_ref->type == REF_SUBSTRING)
{
mpz_t char_len;
expr->ts.cl = char_ref->u.ss.length;
mpz_init_set_ui (char_len, 1);
mpz_add (char_len, char_len,
char_ref->u.ss.end->value.integer);
mpz_sub (char_len, char_len,
char_ref->u.ss.start->value.integer);
expr->ts.cl->backend_decl
= gfc_conv_mpz_to_tree (char_len,
gfc_default_character_kind);
/* Cast is necessary for *-charlen refs. */
expr->ts.cl->backend_decl
= convert (gfc_charlen_type_node,
expr->ts.cl->backend_decl);
mpz_clear (char_len);
break;
}
gcc_assert (char_ref != NULL);
loop.temp_ss->data.temp.type
= gfc_typenode_for_spec (&expr->ts);
loop.temp_ss->string_length = expr->ts.cl->backend_decl;
}
else if (expr->ts.cl->length
&& expr->ts.cl->length->expr_type == EXPR_CONSTANT)
{
expr->ts.cl->backend_decl
= gfc_conv_mpz_to_tree (expr->ts.cl->length->value.integer,

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2006-06-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/28118
* gfortran.dg/actual_array_substr_1.f90: New test.
2006-06-24 Olivier Hainque <hainque@adacore.com>
* gnat.dg/scalar_mode_agg_compare_loop.adb: New test.

22
gcc/testsuite/gfortran.dg/actual_array_substr_1.f90 Normal file
View File

@ -0,0 +1,22 @@
! { dg-do run }
! Test fix of PR28118, in which a substring reference to an
! actual argument with an array reference would cause a segfault.
!
! Contributed by Paul Thomas <pault@gcc.gnu.org>
!
program gfcbug33
character(12) :: a(2)
a(1) = "abcdefghijkl"
a(2) = "mnopqrstuvwx"
call foo ((a(2:1:-1)(6:)))
call bar ((a(:)(7:11)))
contains
subroutine foo (chr)
character(7) :: chr(:)
if (chr(1)//chr(2) .ne. "rstuvwxfghijkl") call abort ()
end subroutine foo
subroutine bar (chr)
character(*) :: chr(:)
if (trim(chr(1))//trim(chr(2)) .ne. "ghijkstuvw") call abort ()
end subroutine bar
end program gfcbug33