diff options
| author | Thomas Koenig <Thomas.Koenig@online.de> | 2005-04-22 20:02:44 +0000 |
|---|---|---|
| committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2005-04-22 20:02:44 +0000 |
| commit | da8f3dcc5b46431cf734324750c9435134c78337 (patch) | |
| tree | cc0f19f26285884c6cba161ccbe33d495e898bb9 /libgfortran/m4 | |
| parent | f00fac9d2ffa5ea91809ef1ec85aae415889429c (diff) | |
| download | gcc-da8f3dcc5b46431cf734324750c9435134c78337.zip gcc-da8f3dcc5b46431cf734324750c9435134c78337.tar.gz gcc-da8f3dcc5b46431cf734324750c9435134c78337.tar.bz2 | |
05-04-22 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/20074
PR libfortran/20436
PR libfortran/21108
* gfortran.dg/nested_reshape.f90: new test
* gfortran.dg/reshape-alloc.f90: new test
* gfortran.dg/reshape.f90: new test
2005-04-22 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/20074
PR libfortran/20436
PR libfortran/21108
* m4/reshape.m4 (reshape_`'rtype_kind): rs, rex: New
variables, to be used in calculation of return array sizes.
Populate return array descriptor if ret->data is NULL.
Fix condition for early return (it used to test something
undefined if order was used).
Remove duplicate check wether pad is used.
* intrinsics/reshape_generic.c (reshape_generic): Likewise.
Fix a few places where the wrong variables were set.
* generated/reshape_i4.c: Regenerated.
* generated/reshape_i8.c: Regenerated.
From-SVN: r98585
Diffstat (limited to 'libgfortran/m4')
| -rw-r--r-- | libgfortran/m4/reshape.m4 | 32 |
1 files changed, 26 insertions, 6 deletions
diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/m4/reshape.m4 index 22e2536..541377f 100644 --- a/libgfortran/m4/reshape.m4 +++ b/libgfortran/m4/reshape.m4 @@ -55,6 +55,8 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, index_type rstride0; index_type rdim; index_type rsize; + index_type rs; + index_type rex; rtype_name *rptr; /* s.* indicates the source array. */ index_type scount[GFC_MAX_DIMENSIONS]; @@ -76,8 +78,6 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, int n; int dim; - if (ret->dim[0].stride == 0) - ret->dim[0].stride = 1; if (source->dim[0].stride == 0) source->dim[0].stride = 1; if (shape->dim[0].stride == 0) @@ -87,7 +87,29 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, if (order && order->dim[0].stride == 0) order->dim[0].stride = 1; - rdim = GFC_DESCRIPTOR_RANK (ret); + if (ret->data == NULL) + { + rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1; + rs = 1; + for (n=0; n < rdim; n++) + { + ret->dim[n].lbound = 0; + rex = shape->data[n * shape->dim[0].stride]; + ret->dim[n].ubound = rex - 1; + ret->dim[n].stride = rs; + rs *= rex; + } + ret->base = 0; + ret->data = internal_malloc_size ( rs * sizeof (rtype_name)); + ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim; + } + else + { + rdim = GFC_DESCRIPTOR_RANK (ret); + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + } + rsize = 1; for (n = 0; n < rdim; n++) { @@ -107,7 +129,7 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, rsize *= rextent[n]; else rsize = 0; - if (rextent[dim] <= 0) + if (rextent[n] <= 0) return; } @@ -129,8 +151,6 @@ reshape_`'rtype_kind (rtype * ret, rtype * source, shape_type * shape, if (pad) { - if (pad->dim[0].stride == 0) - pad->dim[0].stride = 1; pdim = GFC_DESCRIPTOR_RANK (pad); psize = 1; for (n = 0; n < pdim; n++) |