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.
(cherry picked from commit ff35dbc020
)
This commit is contained in:
parent
eb4336f546
commit
26ea506a1e
|
@ -3503,17 +3503,15 @@ gfc_expr *
|
||||||
gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc_expr *b, gfc_expr *kind)
|
gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc_expr *b, gfc_expr *kind)
|
||||||
{
|
{
|
||||||
gfc_expr *result;
|
gfc_expr *result;
|
||||||
int back, len, lensub;
|
bool back;
|
||||||
int i, j, k, count, index = 0, start;
|
HOST_WIDE_INT len, lensub, start, last, i, index = 0;
|
||||||
|
int k, delta;
|
||||||
|
|
||||||
if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT
|
if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT
|
||||||
|| ( b != NULL && b->expr_type != EXPR_CONSTANT))
|
|| ( b != NULL && b->expr_type != EXPR_CONSTANT))
|
||||||
return NULL;
|
return NULL;
|
||||||
|
|
||||||
if (b != NULL && b->value.logical != 0)
|
back = (b != NULL && b->value.logical != 0);
|
||||||
back = 1;
|
|
||||||
else
|
|
||||||
back = 0;
|
|
||||||
|
|
||||||
k = get_kind (BT_INTEGER, kind, "INDEX", gfc_default_integer_kind);
|
k = get_kind (BT_INTEGER, kind, "INDEX", gfc_default_integer_kind);
|
||||||
if (k == -1)
|
if (k == -1)
|
||||||
|
@ -3530,111 +3528,40 @@ gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc_expr *b, gfc_expr *kind)
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (back == 0)
|
if (lensub == 0)
|
||||||
{
|
{
|
||||||
if (lensub == 0)
|
if (back)
|
||||||
{
|
index = len + 1;
|
||||||
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;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else
|
else
|
||||||
{
|
index = 1;
|
||||||
for (i = 0; i < len; i++)
|
goto done;
|
||||||
{
|
}
|
||||||
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;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
|
if (!back)
|
||||||
|
{
|
||||||
|
last = len + 1 - lensub;
|
||||||
|
start = 0;
|
||||||
|
delta = 1;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
if (lensub == 0)
|
last = -1;
|
||||||
{
|
start = len - lensub;
|
||||||
mpz_set_si (result->value.integer, len + 1);
|
delta = -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[len - i])
|
|
||||||
{
|
|
||||||
index = len - i + 1;
|
|
||||||
goto done;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
|
||||||
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)
|
for (; start != last; start += delta)
|
||||||
{
|
{
|
||||||
index = start + 1;
|
for (i = 0; i < lensub; i++)
|
||||||
goto done;
|
{
|
||||||
}
|
if (x->value.character.string[start + i]
|
||||||
}
|
!= y->value.character.string[i])
|
||||||
else
|
break;
|
||||||
{
|
}
|
||||||
continue;
|
if (i == lensub)
|
||||||
}
|
{
|
||||||
}
|
index = start + 1;
|
||||||
}
|
goto done;
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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" } }
|
Loading…
Reference in New Issue