https://gcc.gnu.org/g:c84a951a8ee151cb4d80dd84f75f421c5f60fa05
commit r15-9671-gc84a951a8ee151cb4d80dd84f75f421c5f60fa05
Author: Jakub Jelinek <ja...@redhat.com>
Date: Tue May 13 14:20:22 2025 +0200
libfortran: Fix up _gfortran_{,m,s}findloc2_s{1,4} [PR120196]
As mentioned in the PR, _gfortran_{,m,s}findloc2_s{1,4} iterate too many
times in the back case if nothing is found.
For !back, the loops are for (i = 1; i <= extent; i++) so i is in the
body [1, extent] if nothing is found, but for back it is
for (i = extent; i >= 0; i--) so i is in the body [0, extent] and compares
one element before the start of the array.
Note, findloc1_s{1,4} uses
for (n = len; n > 0; n--, src -= delta * len_array)
for the back loop and
for (n = 1; n <= len; n++, src += delta * len_array)
for !back. This patch fixes that.
The testcase fails under valgrind without the libgfortran changes and
succeeds with those.
2025-05-13 Jakub Jelinek <ja...@redhat.com>
PR libfortran/120196
* m4/ifindloc2.m4 (header1, header2): For back use i > 0 rather than
i >= 0 as for condition.
* generated/findloc2_s1.c: Regenerate.
* generated/findloc2_s4.c: Regenerate.
* gfortran.dg/pr120196.f90: New test.
(cherry picked from commit 748a7bc4624e7b000f6fdb93a8cf7da73ff193bb)
Diff:
---
gcc/testsuite/gfortran.dg/pr120196.f90 | 26 ++++++++++++++++++++++++++
libgfortran/generated/findloc2_s1.c | 4 ++--
libgfortran/generated/findloc2_s4.c | 4 ++--
libgfortran/m4/ifindloc2.m4 | 4 ++--
4 files changed, 32 insertions(+), 6 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/pr120196.f90
b/gcc/testsuite/gfortran.dg/pr120196.f90
new file mode 100644
index 000000000000..368c43a48f55
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120196.f90
@@ -0,0 +1,26 @@
+! PR libfortran/120196
+! { dg-do run }
+
+program pr120196
+ character(len=:, kind=1), allocatable :: a(:), s
+ character(len=:, kind=4), allocatable :: b(:), t
+ logical, allocatable :: l(:)
+ logical :: m
+ allocate (character(len=16, kind=1) :: a(10), s)
+ allocate (l(10))
+ a(:) = ""
+ s = "*"
+ l = .true.
+ m = .true.
+ if (findloc (a, s, dim=1, back=.true.) .ne. 0) stop 1
+ if (findloc (a, s, mask=l, dim=1, back=.true.) .ne. 0) stop 2
+ if (findloc (a, s, mask=m, dim=1, back=.true.) .ne. 0) stop 3
+ deallocate (a, s)
+ allocate (character(len=16, kind=4) :: b(10), t)
+ b(:) = ""
+ t = "*"
+ if (findloc (b, t, dim=1, back=.true.) .ne. 0) stop 4
+ if (findloc (b, t, mask=l, dim=1, back=.true.) .ne. 0) stop 5
+ if (findloc (b, t, mask=m, dim=1, back=.true.) .ne. 0) stop 6
+ deallocate (b, t, l)
+end program pr120196
diff --git a/libgfortran/generated/findloc2_s1.c
b/libgfortran/generated/findloc2_s1.c
index 0dcfcc591667..eeea821d83c5 100644
--- a/libgfortran/generated/findloc2_s1.c
+++ b/libgfortran/generated/findloc2_s1.c
@@ -49,7 +49,7 @@ findloc2_s1 (gfc_array_s1 * const restrict array, const
GFC_UINTEGER_1 * restric
if (back)
{
src = array->base_addr + (extent - 1) * sstride;
- for (i = extent; i >= 0; i--)
+ for (i = extent; i > 0; i--)
{
if (compare_string (len_array, (char *) src, len_value, (char *)
value) == 0)
return i;
@@ -112,7 +112,7 @@ mfindloc2_s1 (gfc_array_s1 * const restrict array,
{
src = array->base_addr + (extent - 1) * sstride;
mbase += (extent - 1) * mstride;
- for (i = extent; i >= 0; i--)
+ for (i = extent; i > 0; i--)
{
if (*mbase && (compare_string (len_array, (char *) src, len_value,
(char *) value) == 0))
return i;
diff --git a/libgfortran/generated/findloc2_s4.c
b/libgfortran/generated/findloc2_s4.c
index 3ac0d002a7f2..a336e34122aa 100644
--- a/libgfortran/generated/findloc2_s4.c
+++ b/libgfortran/generated/findloc2_s4.c
@@ -49,7 +49,7 @@ findloc2_s4 (gfc_array_s4 * const restrict array, const
GFC_UINTEGER_4 * restric
if (back)
{
src = array->base_addr + (extent - 1) * sstride;
- for (i = extent; i >= 0; i--)
+ for (i = extent; i > 0; i--)
{
if (compare_string_char4 (len_array, src, len_value, value) == 0)
return i;
@@ -112,7 +112,7 @@ mfindloc2_s4 (gfc_array_s4 * const restrict array,
{
src = array->base_addr + (extent - 1) * sstride;
mbase += (extent - 1) * mstride;
- for (i = extent; i >= 0; i--)
+ for (i = extent; i > 0; i--)
{
if (*mbase && (compare_string_char4 (len_array, src, len_value,
value) == 0))
return i;
diff --git a/libgfortran/m4/ifindloc2.m4 b/libgfortran/m4/ifindloc2.m4
index c6f909aa89f0..d309d8b02a4a 100644
--- a/libgfortran/m4/ifindloc2.m4
+++ b/libgfortran/m4/ifindloc2.m4
@@ -41,7 +41,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If
not, see
if (back)
{
src = array->base_addr + (extent - 1) * sstride;
- for (i = extent; i >= 0; i--)
+ for (i = extent; i > 0; i--)
{
if ('comparison`'`)
return i;
@@ -94,7 +94,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If
not, see
{
src = array->base_addr + (extent - 1) * sstride;
mbase += (extent - 1) * mstride;
- for (i = extent; i >= 0; i--)
+ for (i = extent; i > 0; i--)
{
if (*mbase && ('comparison`'`))
return i;
