From ff35dbc02092fbcd3d814fcd9fe8e871c3f741fd Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 21 Jun 2022 23:20:18 +0200
Subject: [PATCH] Fortran: fix simplification of INDEX(str1,str2) [PR105691]

gcc/fortran/ChangeLog:

	PR fortran/105691
	* simplify.cc (gfc_simplify_index): Replace old simplification
	code by the equivalent of the runtime library implementation.  Use
	HOST_WIDE_INT instead of int for string index, length variables.

gcc/testsuite/ChangeLog:

	PR fortran/105691
	* gfortran.dg/index_6.f90: New test.
---
 gcc/fortran/simplify.cc               | 131 ++++++++--------------------------
 gcc/testsuite/gfortran.dg/index_6.f90 |  31 ++++++++
 2 files changed, 60 insertions(+), 102 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/index_6.f90

diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index c8f2ef9..e8e3ec6 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -3515,17 +3515,15 @@ gfc_expr *
 gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc_expr *b, gfc_expr *kind)
 {
   gfc_expr *result;
-  int back, len, lensub;
-  int i, j, k, count, index = 0, start;
+  bool back;
+  HOST_WIDE_INT len, lensub, start, last, i, index = 0;
+  int k, delta;
 
   if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT
       || ( b != NULL && b->expr_type !=  EXPR_CONSTANT))
     return NULL;
 
-  if (b != NULL && b->value.logical != 0)
-    back = 1;
-  else
-    back = 0;
+  back = (b != NULL && b->value.logical != 0);
 
   k = get_kind (BT_INTEGER, kind, "INDEX", gfc_default_integer_kind);
   if (k == -1)
@@ -3542,111 +3540,40 @@ gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc_expr *b, gfc_expr *kind)
       return result;
     }
 
-  if (back == 0)
+  if (lensub == 0)
     {
-      if (lensub == 0)
-	{
-	  mpz_set_si (result->value.integer, 1);
-	  return result;
-	}
-      else if (lensub == 1)
-	{
-	  for (i = 0; i < len; i++)
-	    {
-	      for (j = 0; j < lensub; j++)
-		{
-		  if (y->value.character.string[j]
-		      == x->value.character.string[i])
-		    {
-		      index = i + 1;
-		      goto done;
-		    }
-		}
-	    }
-	}
+      if (back)
+	index = len + 1;
       else
-	{
-	  for (i = 0; i < len; i++)
-	    {
-	      for (j = 0; j < lensub; j++)
-		{
-		  if (y->value.character.string[j]
-		      == x->value.character.string[i])
-		    {
-		      start = i;
-		      count = 0;
-
-		      for (k = 0; k < lensub; k++)
-			{
-			  if (y->value.character.string[k]
-			      == x->value.character.string[k + start])
-			    count++;
-			}
-
-		      if (count == lensub)
-			{
-			  index = start + 1;
-			  goto done;
-			}
-		    }
-		}
-	    }
-	}
+	index = 1;
+      goto done;
+    }
 
+  if (!back)
+    {
+      last = len + 1 - lensub;
+      start = 0;
+      delta = 1;
     }
   else
     {
-      if (lensub == 0)
-	{
-	  mpz_set_si (result->value.integer, len + 1);
-	  return result;
-	}
-      else if (lensub == 1)
+      last = -1;
+      start = len - lensub;
+      delta = -1;
+    }
+
+  for (; start != last; start += delta)
+    {
+      for (i = 0; i < lensub; i++)
 	{
-	  for (i = 0; i < len; i++)
-	    {
-	      for (j = 0; j < lensub; j++)
-		{
-		  if (y->value.character.string[j]
-		      == x->value.character.string[len - i])
-		    {
-		      index = len - i + 1;
-		      goto done;
-		    }
-		}
-	    }
+	  if (x->value.character.string[start + i]
+	      != y->value.character.string[i])
+	    break;
 	}
-      else
+      if (i == lensub)
 	{
-	  for (i = 0; i < len; i++)
-	    {
-	      for (j = 0; j < lensub; j++)
-		{
-		  if (y->value.character.string[j]
-		      == x->value.character.string[len - i])
-		    {
-		      start = len - i;
-		      if (start <= len - lensub)
-			{
-			  count = 0;
-			  for (k = 0; k < lensub; k++)
-			    if (y->value.character.string[k]
-			        == x->value.character.string[k + start])
-			      count++;
-
-			  if (count == lensub)
-			    {
-			      index = start + 1;
-			      goto done;
-			    }
-			}
-		      else
-			{
-			  continue;
-			}
-		    }
-		}
-	    }
+	  index = start + 1;
+	  goto done;
 	}
     }
 
diff --git a/gcc/testsuite/gfortran.dg/index_6.f90 b/gcc/testsuite/gfortran.dg/index_6.f90
new file mode 100644
index 0000000..61d4929
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/index_6.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+! PR fortran/105691 - Incorrect calculation of INDEX(str1,str2) at compile time
+
+program main
+  implicit none
+  integer :: i
+  character(*), parameter :: s1 = "fortran.f90"
+  character(*), parameter :: s2 = "fortran"
+  character(*), parameter :: s3 = s2 // "*"
+  integer, parameter :: i0    = index(s1, s2)
+  integer, parameter :: i1    = index(s1, s2, back= .true.)
+  integer, parameter :: i2(*) = index(s1, s2, back=[.true.,.false.])
+  integer, parameter :: i3(*) = index(s1, s2, back=[(i==1, i=1,2)] )
+  integer, parameter :: i4    = index(s1, s3)
+  integer, parameter :: i5    = index(s1, s3, back= .true.)
+  integer, parameter :: i6(*) = index(s1, s3, back=[.true.,.false.])
+  integer, parameter :: i7(*) = index(s1, s3, back=[(i==1, i=1,2)] )
+  integer, parameter :: i8    = index(s1, "f", back= .true.)
+  if (     i0 /= 1 ) stop 1
+  if (     i1 /= 1 ) stop 2
+  if (any (i2 /= 1)) stop 3
+  if (any (i3 /= 1)) stop 4
+  if (     i4 /= 0 ) stop 5
+  if (     i5 /= 0 ) stop 6
+  if (any (i6 /= 0)) stop 7
+  if (any (i7 /= 0)) stop 8
+  if (i8 /= len(s1)-2) stop 9
+end program
+
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } }
-- 
2.7.4