From 47c07d96b1c8e56efb61114c2f48724f32561a22 Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert Date: Fri, 3 Nov 2006 12:51:09 +0100 Subject: re PR libfortran/27895 (problem with RESHAPE and zero-sized arrays) PR libfortran/27895 * intrinsics/reshape_generic.c (reshape_internal): Fix so that it works correctly for zero-sized arrays. * m4/reshape.m4: Likewise. * generated/reshape_r16.c: Regenerate. * generated/reshape_c4.c: Regenerate. * generated/reshape_i4.c: Regenerate. * generated/reshape_c16.c: Regenerate. * generated/reshape_r10.c: Regenerate. * generated/reshape_r8.c: Regenerate. * generated/reshape_c10.c: Regenerate. * generated/reshape_c8.c: Regenerate. * generated/reshape_i8.c: Regenerate. * generated/reshape_i16.c: Regenerate. * generated/reshape_r4.c: Regenerate. * gcc/testsuite/gfortran.dg/zero_sized_1.f90: Uncomment checks for RESHAPE. From-SVN: r118455 --- libgfortran/intrinsics/reshape_generic.c | 42 ++++++++++++++++++++++++++------ 1 file changed, 35 insertions(+), 7 deletions(-) (limited to 'libgfortran/intrinsics/reshape_generic.c') diff --git a/libgfortran/intrinsics/reshape_generic.c b/libgfortran/intrinsics/reshape_generic.c index 97860b66299..c58fab01795 100644 --- a/libgfortran/intrinsics/reshape_generic.c +++ b/libgfortran/intrinsics/reshape_generic.c @@ -37,9 +37,6 @@ Boston, MA 02110-1301, USA. */ typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) parray; -/* The shape parameter is ignored. We can currently deduce the shape from the - return array. */ - static void reshape_internal (parray *ret, parray *source, shape_type *shape, parray *pad, shape_type *order, index_type size) @@ -73,12 +70,13 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, const char *src; int n; int dim; + int sempty, pempty; if (ret->data == NULL) { rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; rs = 1; - for (n=0; n < rdim; n++) + for (n = 0; n < rdim; n++) { ret->dim[n].lbound = 0; rex = shape->data[n * shape->dim[0].stride]; @@ -120,13 +118,17 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, sdim = GFC_DESCRIPTOR_RANK (source); ssize = 1; + sempty = 0; for (n = 0; n < sdim; n++) { scount[n] = 0; sstride[n] = source->dim[n].stride; sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; if (sextent[n] <= 0) - abort (); + { + sempty = 1; + sextent[n] = 0; + } if (ssize == sstride[n]) ssize *= sextent[n]; @@ -138,13 +140,18 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, { pdim = GFC_DESCRIPTOR_RANK (pad); psize = 1; + pempty = 0; for (n = 0; n < pdim; n++) { pcount[n] = 0; pstride[n] = pad->dim[n].stride; pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; if (pextent[n] <= 0) - abort (); + { + pempty = 1; + pextent[n] = 0; + } + if (psize == pstride[n]) psize *= pextent[n]; else @@ -156,6 +163,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, { pdim = 0; psize = 1; + pempty = 1; pptr = NULL; } @@ -173,6 +181,24 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, rstride0 = rstride[0] * size; sstride0 = sstride[0] * size; + if (sempty && pempty) + abort (); + + if (sempty) + { + /* Switch immediately to the pad array. */ + src = pptr; + sptr = NULL; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = sstride[0] * size; + } + } + while (rptr) { /* Select between the source and pad arrays. */ @@ -182,6 +208,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, src += sstride0; rcount[0]++; scount[0]++; + /* Advance to the next destination element. */ n = 0; while (rcount[n] == rextent[n]) @@ -204,7 +231,8 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, rcount[n]++; rptr += rstride[n] * size; } - } + } + /* Advance to the next source element. */ n = 0; while (scount[n] == sextent[n]) -- cgit v1.2.1