diff options
author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2008-11-23 19:25:42 +0000 |
---|---|---|
committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2008-11-23 19:25:42 +0000 |
commit | bd72cbc822b6ebc444552bfd221f2ab7fab7aa72 (patch) | |
tree | 8e04046feccd988d44cf864147388e601a376d4c /libgfortran | |
parent | 786a13d0d45ee319ca86ce8235d529478d70c568 (diff) | |
download | gcc-bd72cbc822b6ebc444552bfd221f2ab7fab7aa72.zip gcc-bd72cbc822b6ebc444552bfd221f2ab7fab7aa72.tar.gz gcc-bd72cbc822b6ebc444552bfd221f2ab7fab7aa72.tar.bz2 |
re PR libfortran/38234 (In Reshape, SOURCE can be bigger than result)
2008-11-23 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/38234
* intrinsics/reshape_generic.c (reshape_internal):
Source can be larger than shape.
* m4/reshape.m4: Likewise.
* generated/reshape_c10.c Regenerated.
* generated/reshape_c16.c Regenerated.
* generated/reshape_c4.c Regenerated.
* generated/reshape_c8.c Regenerated.
* generated/reshape_i16.c Regenerated.
* generated/reshape_i4.c Regenerated.
* generated/reshape_i8.c Regenerated.
* generated/reshape_r10.c Regenerated.
* generated/reshape_r16.c Regenerated.
* generated/reshape_r4.c Regenerated.
* generated/reshape_r8.c Regenerated.
2008-11-23 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/38234
* gfortran.dg/reshape_4.f90: New test.
From-SVN: r142137
Diffstat (limited to 'libgfortran')
-rw-r--r-- | libgfortran/ChangeLog | 18 | ||||
-rw-r--r-- | libgfortran/generated/reshape_c10.c | 64 | ||||
-rw-r--r-- | libgfortran/generated/reshape_c16.c | 64 | ||||
-rw-r--r-- | libgfortran/generated/reshape_c4.c | 64 | ||||
-rw-r--r-- | libgfortran/generated/reshape_c8.c | 64 | ||||
-rw-r--r-- | libgfortran/generated/reshape_i16.c | 64 | ||||
-rw-r--r-- | libgfortran/generated/reshape_i4.c | 64 | ||||
-rw-r--r-- | libgfortran/generated/reshape_i8.c | 64 | ||||
-rw-r--r-- | libgfortran/generated/reshape_r10.c | 64 | ||||
-rw-r--r-- | libgfortran/generated/reshape_r16.c | 64 | ||||
-rw-r--r-- | libgfortran/generated/reshape_r4.c | 64 | ||||
-rw-r--r-- | libgfortran/generated/reshape_r8.c | 64 | ||||
-rw-r--r-- | libgfortran/intrinsics/reshape_generic.c | 64 | ||||
-rw-r--r-- | libgfortran/m4/reshape.m4 | 64 |
14 files changed, 434 insertions, 416 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 353b884..36c0098 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,21 @@ +2008-11-23 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR libfortran/38234 + * intrinsics/reshape_generic.c (reshape_internal): + Source can be larger than shape. + * m4/reshape.m4: Likewise. + * generated/reshape_c10.c Regenerated. + * generated/reshape_c16.c Regenerated. + * generated/reshape_c4.c Regenerated. + * generated/reshape_c8.c Regenerated. + * generated/reshape_i16.c Regenerated. + * generated/reshape_i4.c Regenerated. + * generated/reshape_i8.c Regenerated. + * generated/reshape_r10.c Regenerated. + * generated/reshape_r16.c Regenerated. + * generated/reshape_r4.c Regenerated. + * generated/reshape_r8.c Regenerated. + 2008-11-22 Danny Smith <dannysmith@users.sourceforge.net> * libgfortran.h (__mingw_snprintf): Declare with gnu_printf diff --git a/libgfortran/generated/reshape_c10.c b/libgfortran/generated/reshape_c10.c index 3305994..53e59db 100644 --- a/libgfortran/generated/reshape_c10.c +++ b/libgfortran/generated/reshape_c10.c @@ -119,6 +119,37 @@ reshape_c10 (gfc_array_c10 * const restrict ret, if (shape_empty) return; + if (pad) + { + 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) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + if (unlikely (compile_options.bounds_check)) { index_type ret_extent, source_extent; @@ -144,7 +175,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret, source_extent *= se > 0 ? se : 0; } - if (rs < source_extent || (rs > source_extent && !pad)) + if (rs > source_extent && (!pad || pempty)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -219,37 +250,6 @@ reshape_c10 (gfc_array_c10 * const restrict ret, ssize = 0; } - if (pad) - { - 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) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_COMPLEX_10); diff --git a/libgfortran/generated/reshape_c16.c b/libgfortran/generated/reshape_c16.c index 3b026a5..19cfdfc 100644 --- a/libgfortran/generated/reshape_c16.c +++ b/libgfortran/generated/reshape_c16.c @@ -119,6 +119,37 @@ reshape_c16 (gfc_array_c16 * const restrict ret, if (shape_empty) return; + if (pad) + { + 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) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + if (unlikely (compile_options.bounds_check)) { index_type ret_extent, source_extent; @@ -144,7 +175,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret, source_extent *= se > 0 ? se : 0; } - if (rs < source_extent || (rs > source_extent && !pad)) + if (rs > source_extent && (!pad || pempty)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -219,37 +250,6 @@ reshape_c16 (gfc_array_c16 * const restrict ret, ssize = 0; } - if (pad) - { - 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) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_COMPLEX_16); diff --git a/libgfortran/generated/reshape_c4.c b/libgfortran/generated/reshape_c4.c index 1c4740c..64156d9 100644 --- a/libgfortran/generated/reshape_c4.c +++ b/libgfortran/generated/reshape_c4.c @@ -119,6 +119,37 @@ reshape_c4 (gfc_array_c4 * const restrict ret, if (shape_empty) return; + if (pad) + { + 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) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + if (unlikely (compile_options.bounds_check)) { index_type ret_extent, source_extent; @@ -144,7 +175,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret, source_extent *= se > 0 ? se : 0; } - if (rs < source_extent || (rs > source_extent && !pad)) + if (rs > source_extent && (!pad || pempty)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -219,37 +250,6 @@ reshape_c4 (gfc_array_c4 * const restrict ret, ssize = 0; } - if (pad) - { - 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) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_COMPLEX_4); diff --git a/libgfortran/generated/reshape_c8.c b/libgfortran/generated/reshape_c8.c index d68ea48..5ba646c 100644 --- a/libgfortran/generated/reshape_c8.c +++ b/libgfortran/generated/reshape_c8.c @@ -119,6 +119,37 @@ reshape_c8 (gfc_array_c8 * const restrict ret, if (shape_empty) return; + if (pad) + { + 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) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + if (unlikely (compile_options.bounds_check)) { index_type ret_extent, source_extent; @@ -144,7 +175,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret, source_extent *= se > 0 ? se : 0; } - if (rs < source_extent || (rs > source_extent && !pad)) + if (rs > source_extent && (!pad || pempty)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -219,37 +250,6 @@ reshape_c8 (gfc_array_c8 * const restrict ret, ssize = 0; } - if (pad) - { - 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) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_COMPLEX_8); diff --git a/libgfortran/generated/reshape_i16.c b/libgfortran/generated/reshape_i16.c index f46d758..81223ea 100644 --- a/libgfortran/generated/reshape_i16.c +++ b/libgfortran/generated/reshape_i16.c @@ -119,6 +119,37 @@ reshape_16 (gfc_array_i16 * const restrict ret, if (shape_empty) return; + if (pad) + { + 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) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + if (unlikely (compile_options.bounds_check)) { index_type ret_extent, source_extent; @@ -144,7 +175,7 @@ reshape_16 (gfc_array_i16 * const restrict ret, source_extent *= se > 0 ? se : 0; } - if (rs < source_extent || (rs > source_extent && !pad)) + if (rs > source_extent && (!pad || pempty)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -219,37 +250,6 @@ reshape_16 (gfc_array_i16 * const restrict ret, ssize = 0; } - if (pad) - { - 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) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_INTEGER_16); diff --git a/libgfortran/generated/reshape_i4.c b/libgfortran/generated/reshape_i4.c index d868c93..911f2d7 100644 --- a/libgfortran/generated/reshape_i4.c +++ b/libgfortran/generated/reshape_i4.c @@ -119,6 +119,37 @@ reshape_4 (gfc_array_i4 * const restrict ret, if (shape_empty) return; + if (pad) + { + 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) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + if (unlikely (compile_options.bounds_check)) { index_type ret_extent, source_extent; @@ -144,7 +175,7 @@ reshape_4 (gfc_array_i4 * const restrict ret, source_extent *= se > 0 ? se : 0; } - if (rs < source_extent || (rs > source_extent && !pad)) + if (rs > source_extent && (!pad || pempty)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -219,37 +250,6 @@ reshape_4 (gfc_array_i4 * const restrict ret, ssize = 0; } - if (pad) - { - 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) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_INTEGER_4); diff --git a/libgfortran/generated/reshape_i8.c b/libgfortran/generated/reshape_i8.c index bcd984f..b5f9c1e 100644 --- a/libgfortran/generated/reshape_i8.c +++ b/libgfortran/generated/reshape_i8.c @@ -119,6 +119,37 @@ reshape_8 (gfc_array_i8 * const restrict ret, if (shape_empty) return; + if (pad) + { + 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) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + if (unlikely (compile_options.bounds_check)) { index_type ret_extent, source_extent; @@ -144,7 +175,7 @@ reshape_8 (gfc_array_i8 * const restrict ret, source_extent *= se > 0 ? se : 0; } - if (rs < source_extent || (rs > source_extent && !pad)) + if (rs > source_extent && (!pad || pempty)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -219,37 +250,6 @@ reshape_8 (gfc_array_i8 * const restrict ret, ssize = 0; } - if (pad) - { - 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) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_INTEGER_8); diff --git a/libgfortran/generated/reshape_r10.c b/libgfortran/generated/reshape_r10.c index ac02959..57dca1a 100644 --- a/libgfortran/generated/reshape_r10.c +++ b/libgfortran/generated/reshape_r10.c @@ -119,6 +119,37 @@ reshape_r10 (gfc_array_r10 * const restrict ret, if (shape_empty) return; + if (pad) + { + 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) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + if (unlikely (compile_options.bounds_check)) { index_type ret_extent, source_extent; @@ -144,7 +175,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret, source_extent *= se > 0 ? se : 0; } - if (rs < source_extent || (rs > source_extent && !pad)) + if (rs > source_extent && (!pad || pempty)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -219,37 +250,6 @@ reshape_r10 (gfc_array_r10 * const restrict ret, ssize = 0; } - if (pad) - { - 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) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_REAL_10); diff --git a/libgfortran/generated/reshape_r16.c b/libgfortran/generated/reshape_r16.c index c12fab5..4509df5 100644 --- a/libgfortran/generated/reshape_r16.c +++ b/libgfortran/generated/reshape_r16.c @@ -119,6 +119,37 @@ reshape_r16 (gfc_array_r16 * const restrict ret, if (shape_empty) return; + if (pad) + { + 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) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + if (unlikely (compile_options.bounds_check)) { index_type ret_extent, source_extent; @@ -144,7 +175,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret, source_extent *= se > 0 ? se : 0; } - if (rs < source_extent || (rs > source_extent && !pad)) + if (rs > source_extent && (!pad || pempty)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -219,37 +250,6 @@ reshape_r16 (gfc_array_r16 * const restrict ret, ssize = 0; } - if (pad) - { - 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) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_REAL_16); diff --git a/libgfortran/generated/reshape_r4.c b/libgfortran/generated/reshape_r4.c index aa4bdec..c913557 100644 --- a/libgfortran/generated/reshape_r4.c +++ b/libgfortran/generated/reshape_r4.c @@ -119,6 +119,37 @@ reshape_r4 (gfc_array_r4 * const restrict ret, if (shape_empty) return; + if (pad) + { + 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) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + if (unlikely (compile_options.bounds_check)) { index_type ret_extent, source_extent; @@ -144,7 +175,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret, source_extent *= se > 0 ? se : 0; } - if (rs < source_extent || (rs > source_extent && !pad)) + if (rs > source_extent && (!pad || pempty)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -219,37 +250,6 @@ reshape_r4 (gfc_array_r4 * const restrict ret, ssize = 0; } - if (pad) - { - 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) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_REAL_4); diff --git a/libgfortran/generated/reshape_r8.c b/libgfortran/generated/reshape_r8.c index bacaaac..33ce1f0 100644 --- a/libgfortran/generated/reshape_r8.c +++ b/libgfortran/generated/reshape_r8.c @@ -119,6 +119,37 @@ reshape_r8 (gfc_array_r8 * const restrict ret, if (shape_empty) return; + if (pad) + { + 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) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + if (unlikely (compile_options.bounds_check)) { index_type ret_extent, source_extent; @@ -144,7 +175,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret, source_extent *= se > 0 ? se : 0; } - if (rs < source_extent || (rs > source_extent && !pad)) + if (rs > source_extent && (!pad || pempty)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -219,37 +250,6 @@ reshape_r8 (gfc_array_r8 * const restrict ret, ssize = 0; } - if (pad) - { - 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) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof (GFC_REAL_8); diff --git a/libgfortran/intrinsics/reshape_generic.c b/libgfortran/intrinsics/reshape_generic.c index 8e1fedb..e1cc92a 100644 --- a/libgfortran/intrinsics/reshape_generic.c +++ b/libgfortran/intrinsics/reshape_generic.c @@ -108,6 +108,37 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, if (shape_empty) return; + if (pad) + { + 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) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + if (unlikely (compile_options.bounds_check)) { index_type ret_extent, source_extent; @@ -133,7 +164,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, source_extent *= se > 0 ? se : 0; } - if (rs < source_extent || (rs > source_extent && !pad)) + if (rs > source_extent && (!pad || pempty)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -206,37 +237,6 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, ssize = 0; } - if (pad) - { - 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) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= size; diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/m4/reshape.m4 index aa5d429..53a626e 100644 --- a/libgfortran/m4/reshape.m4 +++ b/libgfortran/m4/reshape.m4 @@ -123,6 +123,37 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, if (shape_empty) return; + if (pad) + { + 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) + { + pempty = 1; + pextent[n] = 0; + } + + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pempty = 1; + pptr = NULL; + } + if (unlikely (compile_options.bounds_check)) { index_type ret_extent, source_extent; @@ -148,7 +179,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, source_extent *= se > 0 ? se : 0; } - if (rs < source_extent || (rs > source_extent && !pad)) + if (rs > source_extent && (!pad || pempty)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -223,37 +254,6 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, ssize = 0; } - if (pad) - { - 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) - { - pempty = 1; - pextent[n] = 0; - } - - if (psize == pstride[n]) - psize *= pextent[n]; - else - psize = 0; - } - pptr = pad->data; - } - else - { - pdim = 0; - psize = 1; - pempty = 1; - pptr = NULL; - } - if (rsize != 0 && ssize != 0 && psize != 0) { rsize *= sizeof ('rtype_name`); |