procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/32594 (substring simplification leads to ICE)

Browse source 
PR fortran/32594

	* trans-expr.c (gfc_conv_substring_expr): Only call
	gfc_conv_substring if expr->ref is not NULL.
	* expr.c (gfc_is_constant_expr): If e->ref is NULL, the substring
	expression might be a constant.
	(gfc_simplify_expr): Handle missing start and end, as well as
	missing ref.

	* gfortran.dg/substr_5.f90: New test.

From-SVN: r127478
This commit is contained in:
Francois-Xavier Coudert 2007-08-14 12:44:19 +00:00 • committed by François-Xavier Coudert
parent 9ef0c8d982
commit 9a251aa118
5 changed files with 80 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View file

@ -1,3 +1,13 @@
2007-08-14 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/32594
* trans-expr.c (gfc_conv_substring_expr): Only call
gfc_conv_substring if expr->ref is not NULL.
* expr.c (gfc_is_constant_expr): If e->ref is NULL, the substring
expression might be a constant.
(gfc_simplify_expr): Handle missing start and end, as well as
missing ref.
2007-08-13 Paul Thomas <pault@gcc.gnu.org>
PR fortran/32926

20
gcc/fortran/expr.c
View file

@ -766,8 +766,8 @@ gfc_is_constant_expr (gfc_expr *e)
break;
case EXPR_SUBSTRING:
rv = (gfc_is_constant_expr (e->ref->u.ss.start)
&& gfc_is_constant_expr (e->ref->u.ss.end));
rv = e->ref == NULL || (gfc_is_constant_expr (e->ref->u.ss.start)
&& gfc_is_constant_expr (e->ref->u.ss.end));
break;
case EXPR_STRUCTURE:
@ -1542,9 +1542,19 @@ gfc_simplify_expr (gfc_expr *p, int type)
char *s;
int start, end;
gfc_extract_int (p->ref->u.ss.start, &start);
start--; /* Convert from one-based to zero-based. */
gfc_extract_int (p->ref->u.ss.end, &end);
if (p->ref && p->ref->u.ss.start)
{
gfc_extract_int (p->ref->u.ss.start, &start);
start--; /* Convert from one-based to zero-based. */
}
else
start = 0;
if (p->ref && p->ref->u.ss.end)
gfc_extract_int (p->ref->u.ss.end, &end);
else
end = p->value.character.length;
s = gfc_getmem (end - start + 2);
memcpy (s, p->value.character.string + start, end - start);
s[end - start + 1] = '\0'; /* TODO: C-style string. */

11
gcc/fortran/trans-expr.c
View file

@ -3243,14 +3243,15 @@ gfc_conv_substring_expr (gfc_se * se, gfc_expr * expr)
ref = expr->ref;
gcc_assert (ref->type == REF_SUBSTRING);
gcc_assert (ref == NULL || ref->type == REF_SUBSTRING);
se->expr = gfc_build_string_const(expr->value.character.length,
expr->value.character.string);
se->expr = gfc_build_string_const (expr->value.character.length,
expr->value.character.string);
se->string_length = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (se->expr)));
TYPE_STRING_FLAG (TREE_TYPE (se->expr))=1;
TYPE_STRING_FLAG (TREE_TYPE (se->expr)) = 1;
gfc_conv_substring(se,ref,expr->ts.kind,NULL,&expr->where);
if (ref)
gfc_conv_substring (se, ref, expr->ts.kind, NULL, &expr->where);
}

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2007-08-14 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/32594
* gfortran.dg/substr_5.f90: New test.
2007-08-14 Andrew Pinski <pinskia@gmail.com>
PR c/30428

44
gcc/testsuite/gfortran.dg/substr_5.f90 Normal file
View file

@ -0,0 +1,44 @@
! { dg-do run }
!
character(*), parameter :: chrs = '-+.0123456789eEdD'
character(*), parameter :: expr = '-+.0123456789eEdD'
integer :: i
if (index(chrs(:), expr) /= 1) call abort
if (index(chrs(14:), expr) /= 0) call abort
if (index(chrs(:12), expr) /= 0) call abort
if (index(chrs, expr(:)) /= 1) call abort
if (index(chrs, expr(1:)) /= 1) call abort
if (index(chrs, expr(:1)) /= 1) call abort
if (foo(expr) /= 1) call abort
if (foo(expr) /= 1) call abort
if (foo(expr) /= 1) call abort
if (foo(expr(:)) /= 1) call abort
if (foo(expr(1:)) /= 1) call abort
if (foo(expr(:1)) /= 1) call abort
call bar(expr)
contains
subroutine bar(expr)
character(*), intent(in) :: expr
character(*), parameter :: chrs = '-+.0123456789eEdD'
integer :: foo
if (index(chrs(:), expr) /= 1) call abort
if (index(chrs(14:), expr) /= 0) call abort
if (index(chrs(:12), expr) /= 0) call abort
if (index(chrs, expr(:)) /= 1) call abort
if (index(chrs, expr(1:)) /= 1) call abort
if (index(chrs, expr(:1)) /= 1) call abort
end subroutine bar
integer function foo(expr)
character(*), intent(in) :: expr
character(*), parameter :: chrs = '-+.0123456789eEdD'
foo = index(chrs, expr)
end function foo
end