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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127478 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b6edba4..0801212 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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