From patchwork Tue Jun 21 21:27:29 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 55244 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id EDBA03856DCE for ; Tue, 21 Jun 2022 21:28:18 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org EDBA03856DCE DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1655846899; bh=AsREDilup53LXRDH8qmprbFDaDH8LZ9FyfRX0NsyXD8=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=Vs+o98tabvQmWFNgW5bvXD3uTAO4j4uaUEWd0sS1c58LzdRj7NZEzuOF+e5HfZ3v6 WNKEkweFgOj5AvGRSN223uDwekM6fbHhBVEJL7Uwq2rEBySI5/JvJ97H5fJet1BTVt /EIjm81JC3P8vozPvnMPx0cq+maCTbrcqW5S+DjI= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org 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: To: fortran , gcc-patches Subject: [PATCH] Fortran: fix simplification of INDEX(str1,str2) [PR105691] 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: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" 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 From 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. --- 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 --- 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 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" } } -- 2.35.3