aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gcc/fortran/ChangeLog10
-rw-r--r--gcc/fortran/expr.c20
-rw-r--r--gcc/fortran/trans-expr.c11
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/substr_5.f9044
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