https://gcc.gnu.org/bugzilla/show_bug.cgi?id=119540
anlauf at gcc dot gnu.org changed:
What |Removed |Added
----------------------------------------------------------------------------
CC| |anlauf at gcc dot gnu.org,
| |pault at gcc dot gnu.org
--- Comment #2 from anlauf at gcc dot gnu.org ---
The following testcase shows that the descriptor of the result array
is wrong:
program p
implicit none
integer, parameter :: mm(1,2,3) = 1
print *, shape (reduce (mm, add, 1))
print *, shape (reduce (mm, add, 2))
print *, shape (reduce (mm, add, 3))
print *, reduce (mm, add, 1)
print *, reduce (mm, add, 2)
print *, reduce (mm, add, 3)
contains
pure function add(i,j) result(sum_ij)
integer, intent(in) :: i, j
integer :: sum_ij
sum_ij = i + j
end function add
end
I get:
1 2
1 2
1 2
1 1
2 2
3 3
Expected (e.g. Intel):
2 3
1 3
1 2
1 1 1 1 1 1
2 2 2
3 3
The reason for the wrong extents in the descriptor is likely in the
runtime code. My attempt to fix this was as follows:
diff --git a/libgfortran/intrinsics/reduce.c b/libgfortran/intrinsics/reduce.c
index c8950e41fd0..fec05d5df88 100644
--- a/libgfortran/intrinsics/reduce.c
+++ b/libgfortran/intrinsics/reduce.c
@@ -117,15 +117,20 @@ reduce (parray *ret,
else if (i < dimen_m1)
ext0 *= ext;
else if (i == dimen_m1)
- ext1 = ext;
+ {
+ ext1 = ext;
+ continue;
+ }
else
ext2 *= ext;
/* The dimensions of the return array. */
if (i < (int)(dimen - 1))
GFC_DIMENSION_SET (ret->dim[i], 0, ext - 1, str);
- else if (i < array_rank - 1)
- GFC_DIMENSION_SET (ret->dim[i], 0, ext - 1, str);
+ /* else if (i < array_rank - 1) */
+ /* GFC_DIMENSION_SET (ret->dim[i], 0, ext - 1, str); */
+ else
+ GFC_DIMENSION_SET (ret->dim[i-1], 0, ext - 1, str);
}
if (!scalar_result)
This now leads to:
2 3
1 3
1 2
1 1 1 1 1 1
2 2 0
3 3
This is only almost correct (see dim=2 case).
CC'ing Paul for help.
