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

	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

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