Le 06/11/2023 à 19:20, Harald Anlauf a écrit :
Hi Mikael,
Am 06.11.23 um 12:43 schrieb Mikael Morin:
Remove the forced overwrite of the first dimension of the result array
descriptor to set it to zero extent, in the function templates for
transformational functions doing an array reduction along a
dimension. This
overwrite, which happened before early returning in case the result array
was empty, was wrong because an array may have a non-zero extent in the
first dimension and still be empty if it has a zero extent in a higher
dimension. Overwriting the dimension was resulting in wrong array result
upper bound for the first dimension in that case.
The offending piece of code was present in several places, and this
removes
them all. More precisely, there is only one case to fix for logical
reduction functions, and there are three cases for other reduction
functions, corresponding to non-masked reduction, reduction with array
mask,
and reduction with scalar mask. The impacted m4 files are
ifunction_logical.m4 for logical reduction functions, ifunction.m4 for
regular functions and types, ifunction-s.m4 for character minloc and
maxloc,
ifunction-s2.m4 for character minval and maxval, and ifindloc1.m4 for
findloc.
while your fix seems mechanical and correct, I wonder if you looked
at the following pre-existing irregularity which can be seen in
this snippet:
diff --git a/libgfortran/m4/ifunction.m4 b/libgfortran/m4/ifunction.m4
index 480649cf691..abc15b430ab 100644
--- a/libgfortran/m4/ifunction.m4
+++ b/libgfortran/m4/ifunction.m4
@@ -96,12 +96,7 @@ name`'rtype_qual`_'atype_code` ('rtype` * const
restrict retarray,
retarray->base_addr = xmallocarray (alloc_size, sizeof
(rtype_name));
if (alloc_size == 0)
- {
- /* Make sure we have a zero-sized array. */
- GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
- return;
-
- }
+ return;
}
else
{
This is all enclosed in a block which has
if (retarray->base_addr == NULL)
but allocates and sets retarray->base_addr, while
@@ -290,11 +285,7 @@ m'name`'rtype_qual`_'atype_code` ('rtype` * const
restrict retarray,
retarray->dtype.rank = rank;
if (alloc_size == 0)
- {
- /* Make sure we have a zero-sized array. */
- GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
- return;
- }
+ return;
else
retarray->base_addr = xmallocarray (alloc_size, sizeof
(rtype_name));
and
@@ -454,11 +445,7 @@ void
alloc_size = GFC_DESCRIPTOR_STRIDE(retarray,rank-1) *
extent[rank-1];
if (alloc_size == 0)
- {
- /* Make sure we have a zero-sized array. */
- GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
- return;
- }
+ return;
else
retarray->base_addr = xmallocarray (alloc_size, sizeof
(rtype_name));
}
do not set retarray->base_addr to non-NULL for alloc_size == 0.
Do you know if the first snippet can be safely rewritten to avoid
the (hopefully pointless) xmallocarray for alloc_size == 0?
This change to the testcase:
diff --git a/gcc/testsuite/gfortran.dg/bound_11.f90
b/gcc/testsuite/gfortran.dg/bound_11.f90
index 170eba4ddfd..2e96f843476 100644
--- a/gcc/testsuite/gfortran.dg/bound_11.f90
+++ b/gcc/testsuite/gfortran.dg/bound_11.f90
@@ -88,6 +88,7 @@ contains
m4 = .false.
i = 1
r = sum(a, dim=i)
+ if (.not. allocated(r)) stop 210
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 211
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 212
i = 2
@@ -104,6 +105,7 @@ contains
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 218
i = 1
r = sum(a, dim=i, mask=m1)
+ if (.not. allocated(r)) stop 220
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 221
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 222
i = 2
@@ -120,6 +122,7 @@ contains
if (any(ubound(r) /= (/ 9, 3, 0 /))) stop 228
i = 1
r = sum(a, dim=i, mask=m4)
+ if (.not. allocated(r)) stop 230
if (any(shape(r) /= (/ 3, 0, 7 /))) stop 231
if (any(ubound(r) /= (/ 3, 0, 7 /))) stop 232
i = 2
gives me a FAIL with STOP 220 (or STOP 230 if the STOP 220 line is
commented); the first one with STOP 210 passes.
So it is the first snippet with the xmallocarray (which supports zero
values see memory.c) call that is the correct one.
Good catch, I will open a separate PR.
Mikael
