Skip to content

R
riscv-gcc-1
Commit 47c07d96 by Francois-Xavier Coudert Committed by François-Xavier Coudert
Options

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
parent 54f9963a
Showing with 459 additions and 69 deletions
gcc/testsuite/ChangeLog
2006-11-03 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/27895
* gcc/testsuite/gfortran.dg/zero_sized_1.f90: Uncomment checks
for RESHAPE.
2006-11-02 Brooks Moses <brooks.moses@codesourcery.com>
* lib/gfortran-dg.exp (gfortran-dg-test): Remove expected "In file"
gcc/testsuite/gfortran.dg/zero_sized_1.f90
......@@ -193,5 +193,5 @@ program test
call test_unpack
call test_spread
call test_pack
! call test_reshape
call test_reshape
end
libgfortran/ChangeLog
2006-11-03 Francois-Xavier Coudert <coudert@clipper.ens.fr>
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.
2006-10-31 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/29627
......
libgfortran/generated/reshape_c10.c
......@@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
extern void reshape_c10 (gfc_array_c10 * const restrict,
gfc_array_c10 * const restrict,
......@@ -83,12 +81,13 @@ reshape_c10 (gfc_array_c10 * const restrict ret,
const GFC_COMPLEX_10 *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];
......@@ -130,13 +129,17 @@ reshape_c10 (gfc_array_c10 * const restrict ret,
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];
......@@ -148,13 +151,18 @@ reshape_c10 (gfc_array_c10 * const restrict ret,
{
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
......@@ -166,6 +174,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret,
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
......@@ -183,6 +192,24 @@ reshape_c10 (gfc_array_c10 * const restrict ret,
rstride0 = rstride[0];
sstride0 = sstride[0];
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] * sizeof (GFC_COMPLEX_10);
}
}
while (rptr)
{
/* Select between the source and pad arrays. */
......@@ -192,6 +219,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret,
src += sstride0;
rcount[0]++;
scount[0]++;
/* Advance to the next destination element. */
n = 0;
while (rcount[n] == rextent[n])
......
libgfortran/generated/reshape_c16.c
......@@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
extern void reshape_c16 (gfc_array_c16 * const restrict,
gfc_array_c16 * const restrict,
......@@ -83,12 +81,13 @@ reshape_c16 (gfc_array_c16 * const restrict ret,
const GFC_COMPLEX_16 *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];
......@@ -130,13 +129,17 @@ reshape_c16 (gfc_array_c16 * const restrict ret,
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];
......@@ -148,13 +151,18 @@ reshape_c16 (gfc_array_c16 * const restrict ret,
{
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
......@@ -166,6 +174,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret,
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
......@@ -183,6 +192,24 @@ reshape_c16 (gfc_array_c16 * const restrict ret,
rstride0 = rstride[0];
sstride0 = sstride[0];
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] * sizeof (GFC_COMPLEX_16);
}
}
while (rptr)
{
/* Select between the source and pad arrays. */
......@@ -192,6 +219,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret,
src += sstride0;
rcount[0]++;
scount[0]++;
/* Advance to the next destination element. */
n = 0;
while (rcount[n] == rextent[n])
......
libgfortran/generated/reshape_c4.c
......@@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
extern void reshape_c4 (gfc_array_c4 * const restrict,
gfc_array_c4 * const restrict,
......@@ -83,12 +81,13 @@ reshape_c4 (gfc_array_c4 * const restrict ret,
const GFC_COMPLEX_4 *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];
......@@ -130,13 +129,17 @@ reshape_c4 (gfc_array_c4 * const restrict ret,
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];
......@@ -148,13 +151,18 @@ reshape_c4 (gfc_array_c4 * const restrict ret,
{
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
......@@ -166,6 +174,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret,
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
......@@ -183,6 +192,24 @@ reshape_c4 (gfc_array_c4 * const restrict ret,
rstride0 = rstride[0];
sstride0 = sstride[0];
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] * sizeof (GFC_COMPLEX_4);
}
}
while (rptr)
{
/* Select between the source and pad arrays. */
......@@ -192,6 +219,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret,
src += sstride0;
rcount[0]++;
scount[0]++;
/* Advance to the next destination element. */
n = 0;
while (rcount[n] == rextent[n])
......
libgfortran/generated/reshape_c8.c
......@@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
extern void reshape_c8 (gfc_array_c8 * const restrict,
gfc_array_c8 * const restrict,
......@@ -83,12 +81,13 @@ reshape_c8 (gfc_array_c8 * const restrict ret,
const GFC_COMPLEX_8 *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];
......@@ -130,13 +129,17 @@ reshape_c8 (gfc_array_c8 * const restrict ret,
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];
......@@ -148,13 +151,18 @@ reshape_c8 (gfc_array_c8 * const restrict ret,
{
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
......@@ -166,6 +174,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret,
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
......@@ -183,6 +192,24 @@ reshape_c8 (gfc_array_c8 * const restrict ret,
rstride0 = rstride[0];
sstride0 = sstride[0];
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] * sizeof (GFC_COMPLEX_8);
}
}
while (rptr)
{
/* Select between the source and pad arrays. */
......@@ -192,6 +219,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret,
src += sstride0;
rcount[0]++;
scount[0]++;
/* Advance to the next destination element. */
n = 0;
while (rcount[n] == rextent[n])
......
libgfortran/generated/reshape_i16.c
......@@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
extern void reshape_16 (gfc_array_i16 * const restrict,
gfc_array_i16 * const restrict,
......@@ -83,12 +81,13 @@ reshape_16 (gfc_array_i16 * const restrict ret,
const GFC_INTEGER_16 *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];
......@@ -130,13 +129,17 @@ reshape_16 (gfc_array_i16 * const restrict ret,
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];
......@@ -148,13 +151,18 @@ reshape_16 (gfc_array_i16 * const restrict ret,
{
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
......@@ -166,6 +174,7 @@ reshape_16 (gfc_array_i16 * const restrict ret,
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
......@@ -183,6 +192,24 @@ reshape_16 (gfc_array_i16 * const restrict ret,
rstride0 = rstride[0];
sstride0 = sstride[0];
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] * sizeof (GFC_INTEGER_16);
}
}
while (rptr)
{
/* Select between the source and pad arrays. */
......@@ -192,6 +219,7 @@ reshape_16 (gfc_array_i16 * const restrict ret,
src += sstride0;
rcount[0]++;
scount[0]++;
/* Advance to the next destination element. */
n = 0;
while (rcount[n] == rextent[n])
......
libgfortran/generated/reshape_i4.c
......@@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
extern void reshape_4 (gfc_array_i4 * const restrict,
gfc_array_i4 * const restrict,
......@@ -83,12 +81,13 @@ reshape_4 (gfc_array_i4 * const restrict ret,
const GFC_INTEGER_4 *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];
......@@ -130,13 +129,17 @@ reshape_4 (gfc_array_i4 * const restrict ret,
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];
......@@ -148,13 +151,18 @@ reshape_4 (gfc_array_i4 * const restrict ret,
{
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
......@@ -166,6 +174,7 @@ reshape_4 (gfc_array_i4 * const restrict ret,
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
......@@ -183,6 +192,24 @@ reshape_4 (gfc_array_i4 * const restrict ret,
rstride0 = rstride[0];
sstride0 = sstride[0];
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] * sizeof (GFC_INTEGER_4);
}
}
while (rptr)
{
/* Select between the source and pad arrays. */
......@@ -192,6 +219,7 @@ reshape_4 (gfc_array_i4 * const restrict ret,
src += sstride0;
rcount[0]++;
scount[0]++;
/* Advance to the next destination element. */
n = 0;
while (rcount[n] == rextent[n])
......
libgfortran/generated/reshape_i8.c
......@@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
extern void reshape_8 (gfc_array_i8 * const restrict,
gfc_array_i8 * const restrict,
......@@ -83,12 +81,13 @@ reshape_8 (gfc_array_i8 * const restrict ret,
const GFC_INTEGER_8 *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];
......@@ -130,13 +129,17 @@ reshape_8 (gfc_array_i8 * const restrict ret,
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];
......@@ -148,13 +151,18 @@ reshape_8 (gfc_array_i8 * const restrict ret,
{
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
......@@ -166,6 +174,7 @@ reshape_8 (gfc_array_i8 * const restrict ret,
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
......@@ -183,6 +192,24 @@ reshape_8 (gfc_array_i8 * const restrict ret,
rstride0 = rstride[0];
sstride0 = sstride[0];
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] * sizeof (GFC_INTEGER_8);
}
}
while (rptr)
{
/* Select between the source and pad arrays. */
......@@ -192,6 +219,7 @@ reshape_8 (gfc_array_i8 * const restrict ret,
src += sstride0;
rcount[0]++;
scount[0]++;
/* Advance to the next destination element. */
n = 0;
while (rcount[n] == rextent[n])
......
libgfortran/generated/reshape_r10.c
......@@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
extern void reshape_r10 (gfc_array_r10 * const restrict,
gfc_array_r10 * const restrict,
......@@ -83,12 +81,13 @@ reshape_r10 (gfc_array_r10 * const restrict ret,
const GFC_REAL_10 *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];
......@@ -130,13 +129,17 @@ reshape_r10 (gfc_array_r10 * const restrict ret,
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];
......@@ -148,13 +151,18 @@ reshape_r10 (gfc_array_r10 * const restrict ret,
{
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
......@@ -166,6 +174,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret,
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
......@@ -183,6 +192,24 @@ reshape_r10 (gfc_array_r10 * const restrict ret,
rstride0 = rstride[0];
sstride0 = sstride[0];
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] * sizeof (GFC_REAL_10);
}
}
while (rptr)
{
/* Select between the source and pad arrays. */
......@@ -192,6 +219,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret,
src += sstride0;
rcount[0]++;
scount[0]++;
/* Advance to the next destination element. */
n = 0;
while (rcount[n] == rextent[n])
......
libgfortran/generated/reshape_r16.c
......@@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
extern void reshape_r16 (gfc_array_r16 * const restrict,
gfc_array_r16 * const restrict,
......@@ -83,12 +81,13 @@ reshape_r16 (gfc_array_r16 * const restrict ret,
const GFC_REAL_16 *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];
......@@ -130,13 +129,17 @@ reshape_r16 (gfc_array_r16 * const restrict ret,
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];
......@@ -148,13 +151,18 @@ reshape_r16 (gfc_array_r16 * const restrict ret,
{
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
......@@ -166,6 +174,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret,
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
......@@ -183,6 +192,24 @@ reshape_r16 (gfc_array_r16 * const restrict ret,
rstride0 = rstride[0];
sstride0 = sstride[0];
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] * sizeof (GFC_REAL_16);
}
}
while (rptr)
{
/* Select between the source and pad arrays. */
......@@ -192,6 +219,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret,
src += sstride0;
rcount[0]++;
scount[0]++;
/* Advance to the next destination element. */
n = 0;
while (rcount[n] == rextent[n])
......
libgfortran/generated/reshape_r4.c
......@@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
extern void reshape_r4 (gfc_array_r4 * const restrict,
gfc_array_r4 * const restrict,
......@@ -83,12 +81,13 @@ reshape_r4 (gfc_array_r4 * const restrict ret,
const GFC_REAL_4 *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];
......@@ -130,13 +129,17 @@ reshape_r4 (gfc_array_r4 * const restrict ret,
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];
......@@ -148,13 +151,18 @@ reshape_r4 (gfc_array_r4 * const restrict ret,
{
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
......@@ -166,6 +174,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret,
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
......@@ -183,6 +192,24 @@ reshape_r4 (gfc_array_r4 * const restrict ret,
rstride0 = rstride[0];
sstride0 = sstride[0];
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] * sizeof (GFC_REAL_4);
}
}
while (rptr)
{
/* Select between the source and pad arrays. */
......@@ -192,6 +219,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret,
src += sstride0;
rcount[0]++;
scount[0]++;
/* Advance to the next destination element. */
n = 0;
while (rcount[n] == rextent[n])
......
libgfortran/generated/reshape_r8.c
......@@ -37,8 +37,6 @@ Boston, MA 02110-1301, USA. */
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
extern void reshape_r8 (gfc_array_r8 * const restrict,
gfc_array_r8 * const restrict,
......@@ -83,12 +81,13 @@ reshape_r8 (gfc_array_r8 * const restrict ret,
const GFC_REAL_8 *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];
......@@ -130,13 +129,17 @@ reshape_r8 (gfc_array_r8 * const restrict ret,
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];
......@@ -148,13 +151,18 @@ reshape_r8 (gfc_array_r8 * const restrict ret,
{
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
......@@ -166,6 +174,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret,
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
......@@ -183,6 +192,24 @@ reshape_r8 (gfc_array_r8 * const restrict ret,
rstride0 = rstride[0];
sstride0 = sstride[0];
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] * sizeof (GFC_REAL_8);
}
}
while (rptr)
{
/* Select between the source and pad arrays. */
......@@ -192,6 +219,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret,
src += sstride0;
rcount[0]++;
scount[0]++;
/* Advance to the next destination element. */
n = 0;
while (rcount[n] == rextent[n])
......
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])
......
libgfortran/m4/reshape.m4
......@@ -38,9 +38,9 @@ include(iparm.m4)dnl
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
/* The shape parameter is ignored. We can currently deduce the shape from the
return array. */
dnl Only the kind (ie size) is used to name the function.
dnl For integer routines, only the kind (ie size) is used to name the
dnl function. The same function will be used for integer and logical
dnl arrays of the same kind.
extern void reshape_`'rtype_ccode (rtype * const restrict,
rtype * const restrict,
......@@ -85,12 +85,13 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
const rtype_name *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];
......@@ -132,13 +133,17 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
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];
......@@ -150,13 +155,18 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
{
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
......@@ -168,6 +178,7 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
{
pdim = 0;
psize = 1;
pempty = 1;
pptr = NULL;
}
......@@ -185,6 +196,24 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
rstride0 = rstride[0];
sstride0 = sstride[0];
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] * sizeof (rtype_name);
}
}
while (rptr)
{
/* Select between the source and pad arrays. */
......@@ -194,6 +223,7 @@ reshape_`'rtype_ccode (rtype * const restrict ret,
src += sstride0;
rcount[0]++;
scount[0]++;
/* Advance to the next destination element. */
n = 0;
while (rcount[n] == rextent[n])
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment