From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2071) id 0D6073858D28; Fri, 1 Jul 2022 17:55:51 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 0D6073858D28 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Harald Anlauf To: gcc-cvs@gcc.gnu.org Subject: [gcc r10-10877] Fortran: fix simplification of INDEX(str1, str2) [PR105691] X-Act-Checkin: gcc X-Git-Author: Harald Anlauf X-Git-Refname: refs/heads/releases/gcc-10 X-Git-Oldrev: 1214ebb39cd250fda678ec89c785fcea86888a89 X-Git-Newrev: e6db08d9183b80b0ada5122fae79412544279f56 Message-Id: <20220701175551.0D6073858D28@sourceware.org> Date: Fri, 1 Jul 2022 17:55:51 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Fri, 01 Jul 2022 17:55:51 -0000 https://gcc.gnu.org/g:e6db08d9183b80b0ada5122fae79412544279f56 commit r10-10877-ge6db08d9183b80b0ada5122fae79412544279f56 Author: Harald Anlauf Date: Tue Jun 21 23:20:18 2022 +0200 Fortran: fix simplification of INDEX(str1,str2) [PR105691] gcc/fortran/ChangeLog: PR fortran/105691 * simplify.c (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 ff35dbc02092fbcd3d814fcd9fe8e871c3f741fd) Diff: --- gcc/fortran/simplify.c | 131 ++++++++-------------------------- gcc/testsuite/gfortran.dg/index_6.f90 | 31 ++++++++ 2 files changed, 60 insertions(+), 102 deletions(-) diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index f0f322c1caf..a4e014a746f 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -3470,17 +3470,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) @@ -3497,111 +3495,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 00000000000..61d492985ad --- /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" } }