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  <jakub@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.
This commit is contained in:
Jakub Jelinek 2025-05-13 14:20:22 +02:00 committed by Jakub Jelinek
parent 781cfc454b
commit 748a7bc462
4 changed files with 32 additions and 6 deletions

View File

@ -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

View File

@ -49,7 +49,7 @@ findloc2_s1 (gfc_array_s1 * const restrict array, const GFC_UINTEGER_1 * restric
if (back) if (back)
{ {
src = array->base_addr + (extent - 1) * sstride; 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) if (compare_string (len_array, (char *) src, len_value, (char *) value) == 0)
return i; return i;
@ -112,7 +112,7 @@ mfindloc2_s1 (gfc_array_s1 * const restrict array,
{ {
src = array->base_addr + (extent - 1) * sstride; src = array->base_addr + (extent - 1) * sstride;
mbase += (extent - 1) * mstride; 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)) if (*mbase && (compare_string (len_array, (char *) src, len_value, (char *) value) == 0))
return i; return i;

View File

@ -49,7 +49,7 @@ findloc2_s4 (gfc_array_s4 * const restrict array, const GFC_UINTEGER_4 * restric
if (back) if (back)
{ {
src = array->base_addr + (extent - 1) * sstride; 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) if (compare_string_char4 (len_array, src, len_value, value) == 0)
return i; return i;
@ -112,7 +112,7 @@ mfindloc2_s4 (gfc_array_s4 * const restrict array,
{ {
src = array->base_addr + (extent - 1) * sstride; src = array->base_addr + (extent - 1) * sstride;
mbase += (extent - 1) * mstride; 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)) if (*mbase && (compare_string_char4 (len_array, src, len_value, value) == 0))
return i; return i;

View File

@ -41,7 +41,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
if (back) if (back)
{ {
src = array->base_addr + (extent - 1) * sstride; src = array->base_addr + (extent - 1) * sstride;
for (i = extent; i >= 0; i--) for (i = extent; i > 0; i--)
{ {
if ('comparison`'`) if ('comparison`'`)
return i; return i;
@ -94,7 +94,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
{ {
src = array->base_addr + (extent - 1) * sstride; src = array->base_addr + (extent - 1) * sstride;
mbase += (extent - 1) * mstride; mbase += (extent - 1) * mstride;
for (i = extent; i >= 0; i--) for (i = extent; i > 0; i--)
{ {
if (*mbase && ('comparison`'`)) if (*mbase && ('comparison`'`))
return i; return i;