diff options
-rw-r--r-- | gcc/fortran/ChangeLog | 10 | ||||
-rw-r--r-- | gcc/fortran/expr.c | 20 | ||||
-rw-r--r-- | gcc/fortran/trans-expr.c | 11 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/substr_5.f90 | 44 |
5 files changed, 80 insertions, 10 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b6edba4..0801212 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -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 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index c295f54..f0de19f 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -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. */ diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index d421a73..02bd91d 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -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); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c55d2df..827f4c4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -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 diff --git a/gcc/testsuite/gfortran.dg/substr_5.f90 b/gcc/testsuite/gfortran.dg/substr_5.f90 new file mode 100644 index 0000000..fb409ea --- /dev/null +++ b/gcc/testsuite/gfortran.dg/substr_5.f90 @@ -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 |