From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.17.20]) by sourceware.org (Postfix) with ESMTPS id 925EA3857409; Tue, 21 Jun 2022 21:27:31 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 925EA3857409 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [79.251.8.155] ([79.251.8.155]) by web-mail.gmx.net (3c-app-gmx-bs01.server.lan [172.19.170.50]) (via HTTP); Tue, 21 Jun 2022 23:27:29 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: fix simplification of INDEX(str1,str2) [PR105691] Content-Type: multipart/mixed; boundary=nika-1accf00c-4945-46f8-b9b5-b02736930c54 Date: Tue, 21 Jun 2022 23:27:29 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:Eo7ywyeywA+wKvbNO1HmzHfwlvRtSmwf1dTOgArL+BAX7+vo7wZZUgAecuTWKNqwu+5LO yB0cjWS7bsOmFxvmqW5eA+1CWIJENUAVvsUBOW1++i0+Ae434CNOJytxGry9Vm63R4o96tiBIsQu 1MHk4DWLzIxUYSKC3XLPeFzZF+XGkxvGyRZDSmb9u7layHQ+HzFEb8301Vb1RHoOcICpC2Hw+SYI LJLbIpQgAxsvh/lzV+N5q/wGZlpUfpt0r3+49AwZjlqAKB7tdlNQoaDIm411ez4O23MXcvznsIeu hw= X-UI-Out-Filterresults: notjunk:1;V03:K0:AEXcsC4Kqyo=:JEOdfbvYGVM0AscEFnqfND eYoe994rTZ6k4tZbCkDETRcMBHmYgXUI1yBSvIjD/Mq73Jg7JIJewNlLkIDgCjMLVhdHpg7bf FdjZBVua+WQbJpBAmMF3tJEwsaYewupw989D7x3KSD31pZTnUgzoPY/+WhfRlxS/E9Q/3igMn SzWYHNqGKyUj/XuR9E5h7cntKb2NsnYq8o4nA1pfCU7mje23wM8c6/1hGednL36k073rxU1zC oYjBmn4hUXHHebGLWA2VC+7SHYyGQMW3l6S9cAcUTF+Q9CTTbjoag1Fdow9N1rSahgTw3COzb lmlkN3sVe2Sf2w9m5U9NUzajO2Xlk8DyKxIgC2hCUgA0TBTw4qlIHvydnLhroIn/SjkIFf8rj r28W6u7OsNKQi0JZGOa34uBqcUGRcNOgxQ/uB+XqvU4dMHdlWUTTAcEbARgBBb2bz+BN1Red5 tGEoauHisE2GcHZRboipJhcO91Df0h6bgfkO6JkQfD+wJwhTrgum7vPE2RRNz1/gxubpIGJpP Q/dFIoMywPyS9uo7659g2ZsVxQo6AgVox3LL9YVWWpbh/MVHQCETKNe//799GEPJnGMH63W8J NcMe/JXBMsXrLAgEeTKd2o45qsh2fYPCOQ9vv41leln4U7B+Al9NM5KjXnaD00ib6XaANYYTP whVmHkYPW5T63u1+BnVTJCK/Mpx5L/8OSfSQMrX/N3wT+3tXub3iqTa74euK3YDIK0FQ6wWlz h/rJt1sPZicU4GdPHkiH9yN7HKq80cw6pVpIkNpEHsW8uPG49WAV+E7Qz9yDffgGsFxXzhlwa 1fMuY6B X-Spam-Status: No, score=-12.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 21 Jun 2022 21:27:34 -0000 --nika-1accf00c-4945-46f8-b9b5-b02736930c54 Content-Type: text/plain; charset=UTF-8 Dear all, compile time simplification of INDEX(str1,str2,back=.true.) gave wrong results. Looking at gfc_simplify_index, this appeared to be close to a complete mess, while the runtime library code - which was developed later - was a relief. The solution is to use the runtime library code as template to fix this. I took the opportunity to change string index and length variables in gfc_simplify_index to HOST_WIDE_INT. Regtested on x86_64-pc-linux-gnu. OK for mainline? As this is a wrong-code issue, would this qualify for backports to open branches? Thanks, Harald --nika-1accf00c-4945-46f8-b9b5-b02736930c54 Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Fortran-fix-simplification-of-INDEX-str1-str2-PR1056.patch Content-Transfer-Encoding: quoted-printable =46rom 2cfe8034340424ffa15784c61584634ccac4c4fc Mon Sep 17 00:00:00 2001 From: Harald Anlauf 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. =2D-- 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 c8f2ef9fbf4..e8e3ec63669 100644 =2D-- 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 =3D 0, start; + bool back; + HOST_WIDE_INT len, lensub, start, last, i, index =3D 0; + int k, delta; if (x->expr_type !=3D EXPR_CONSTANT || y->expr_type !=3D EXPR_CONSTANT || ( b !=3D NULL && b->expr_type !=3D EXPR_CONSTANT)) return NULL; - if (b !=3D NULL && b->value.logical !=3D 0) - back =3D 1; - else - back =3D 0; + back =3D (b !=3D NULL && b->value.logical !=3D 0); k =3D get_kind (BT_INTEGER, kind, "INDEX", gfc_default_integer_kind); if (k =3D=3D -1) @@ -3542,111 +3540,40 @@ gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc= _expr *b, gfc_expr *kind) return result; } - if (back =3D=3D 0) + if (lensub =3D=3D 0) { - if (lensub =3D=3D 0) - { - mpz_set_si (result->value.integer, 1); - return result; - } - else if (lensub =3D=3D 1) - { - for (i =3D 0; i < len; i++) - { - for (j =3D 0; j < lensub; j++) - { - if (y->value.character.string[j] - =3D=3D x->value.character.string[i]) - { - index =3D i + 1; - goto done; - } - } - } - } + if (back) + index =3D len + 1; else - { - for (i =3D 0; i < len; i++) - { - for (j =3D 0; j < lensub; j++) - { - if (y->value.character.string[j] - =3D=3D x->value.character.string[i]) - { - start =3D i; - count =3D 0; - - for (k =3D 0; k < lensub; k++) - { - if (y->value.character.string[k] - =3D=3D x->value.character.string[k + start]) - count++; - } - - if (count =3D=3D lensub) - { - index =3D start + 1; - goto done; - } - } - } - } - } + index =3D 1; + goto done; + } + if (!back) + { + last =3D len + 1 - lensub; + start =3D 0; + delta =3D 1; } else { - if (lensub =3D=3D 0) - { - mpz_set_si (result->value.integer, len + 1); - return result; - } - else if (lensub =3D=3D 1) + last =3D -1; + start =3D len - lensub; + delta =3D -1; + } + + for (; start !=3D last; start +=3D delta) + { + for (i =3D 0; i < lensub; i++) { - for (i =3D 0; i < len; i++) - { - for (j =3D 0; j < lensub; j++) - { - if (y->value.character.string[j] - =3D=3D x->value.character.string[len - i]) - { - index =3D len - i + 1; - goto done; - } - } - } + if (x->value.character.string[start + i] + !=3D y->value.character.string[i]) + break; } - else + if (i =3D=3D lensub) { - for (i =3D 0; i < len; i++) - { - for (j =3D 0; j < lensub; j++) - { - if (y->value.character.string[j] - =3D=3D x->value.character.string[len - i]) - { - start =3D len - i; - if (start <=3D len - lensub) - { - count =3D 0; - for (k =3D 0; k < lensub; k++) - if (y->value.character.string[k] - =3D=3D x->value.character.string[k + start]) - count++; - - if (count =3D=3D lensub) - { - index =3D start + 1; - goto done; - } - } - else - { - continue; - } - } - } - } + index =3D start + 1; + goto done; } } diff --git a/gcc/testsuite/gfortran.dg/index_6.f90 b/gcc/testsuite/gfortra= n.dg/index_6.f90 new file mode 100644 index 00000000000..61d492985ad =2D-- /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 compil= e time + +program main + implicit none + integer :: i + character(*), parameter :: s1 =3D "fortran.f90" + character(*), parameter :: s2 =3D "fortran" + character(*), parameter :: s3 =3D s2 // "*" + integer, parameter :: i0 =3D index(s1, s2) + integer, parameter :: i1 =3D index(s1, s2, back=3D .true.) + integer, parameter :: i2(*) =3D index(s1, s2, back=3D[.true.,.false.]) + integer, parameter :: i3(*) =3D index(s1, s2, back=3D[(i=3D=3D1, i=3D1,= 2)] ) + integer, parameter :: i4 =3D index(s1, s3) + integer, parameter :: i5 =3D index(s1, s3, back=3D .true.) + integer, parameter :: i6(*) =3D index(s1, s3, back=3D[.true.,.false.]) + integer, parameter :: i7(*) =3D index(s1, s3, back=3D[(i=3D=3D1, i=3D1,= 2)] ) + integer, parameter :: i8 =3D index(s1, "f", back=3D .true.) + if ( i0 /=3D 1 ) stop 1 + if ( i1 /=3D 1 ) stop 2 + if (any (i2 /=3D 1)) stop 3 + if (any (i3 /=3D 1)) stop 4 + if ( i4 /=3D 0 ) stop 5 + if ( i5 /=3D 0 ) stop 6 + if (any (i6 /=3D 0)) stop 7 + if (any (i7 /=3D 0)) stop 8 + if (i8 /=3D len(s1)-2) stop 9 +end program + +! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } } =2D- 2.35.3 --nika-1accf00c-4945-46f8-b9b5-b02736930c54--