From d0b5b6ea1ad7a0081f7b0e7f4bc284f49ee51238 Mon Sep 17 00:00:00 2001 From: tkoenig Date: Tue, 18 Nov 2008 22:43:05 +0000 Subject: [PATCH] 2008-11-18 Thomas Koenig PR libfortran/38135 * m4/reshape.m4: Correct bounds checking when PAD is present. Treat PAD as if it were SOURCE when SOURCE is empty. * intrinsics/reshape_generic.c: 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-18 Thomas Koenig PR libfortran/38135 * gfortran.dg/reshape_pad_1.f90: New test case. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@141982 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/reshape_pad_1.f90 | 25 +++++++++++++++++++++++++ libgfortran/ChangeLog | 18 ++++++++++++++++++ libgfortran/generated/reshape_c10.c | 8 ++++---- libgfortran/generated/reshape_c16.c | 8 ++++---- libgfortran/generated/reshape_c4.c | 8 ++++---- libgfortran/generated/reshape_c8.c | 8 ++++---- libgfortran/generated/reshape_i16.c | 8 ++++---- libgfortran/generated/reshape_i4.c | 8 ++++---- libgfortran/generated/reshape_i8.c | 8 ++++---- libgfortran/generated/reshape_r10.c | 8 ++++---- libgfortran/generated/reshape_r16.c | 8 ++++---- libgfortran/generated/reshape_r4.c | 8 ++++---- libgfortran/generated/reshape_r8.c | 8 ++++---- libgfortran/intrinsics/reshape_generic.c | 8 ++++---- libgfortran/m4/reshape.m4 | 8 ++++---- 16 files changed, 100 insertions(+), 52 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/reshape_pad_1.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 27c26a315b5..a2b30961fd4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-11-18 Thomas Koenig + + PR libfortran/38135 + * gfortran.dg/reshape_pad_1.f90: New test case. + 2008-11-18 Uros Bizjak PR target/37362 diff --git a/gcc/testsuite/gfortran.dg/reshape_pad_1.f90 b/gcc/testsuite/gfortran.dg/reshape_pad_1.f90 new file mode 100644 index 00000000000..33afd89e5b3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/reshape_pad_1.f90 @@ -0,0 +1,25 @@ +! { dg-do run } +! PR 38135 - pad to RESHAPE didn't work correctly when SOURCE +! was an empty array. + +program main + implicit none + integer, parameter :: N = 3 + integer(kind=1) :: A1(N,N) + integer(kind=1) :: b1(n+1) + integer(kind=4) :: A4(n,n) + integer(kind=4) :: b4(n+1) + character(len=9) :: line + + b1 = (/ 1, 2, 2, 2 /) + + A1(1:N,1:N)=reshape(A1(1:0,1),(/N,N/),b1) + write(unit=line,fmt='(100i1)') A1 + if (line .ne. "122212221") call abort + + b4 = (/ 3, 4, 4, 4 /) + + a4 = reshape(a4(:0,1),(/n,n/),b4) + write(unit=line,fmt='(100i1)') a4 + if (line .ne. "344434443") call abort +end program main diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 1fd0263e480..95f526a5374 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,21 @@ +2008-11-18 Thomas Koenig + + PR libfortran/38135 + * m4/reshape.m4: Correct bounds checking when PAD is present. + Treat PAD as if it were SOURCE when SOURCE is empty. + * intrinsics/reshape_generic.c: 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-16 Jerry DeLisle PR libfortran/38097 diff --git a/libgfortran/generated/reshape_c10.c b/libgfortran/generated/reshape_c10.c index 567d5b40283..076ea592130 100644 --- a/libgfortran/generated/reshape_c10.c +++ b/libgfortran/generated/reshape_c10.c @@ -137,7 +137,7 @@ reshape_c10 (gfc_array_c10 * const restrict ret, source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; - if (rs != source_extent) + if (rs < source_extent || (rs > source_extent && !pad)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -262,16 +262,16 @@ reshape_c10 (gfc_array_c10 * const restrict ret, if (sempty) { - /* Switch immediately to the pad array. */ + /* Pretend we are using the pad array the first time around, too. */ src = pptr; - sptr = NULL; + sptr = pptr; 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); + sstride0 = pstride[0]; } } diff --git a/libgfortran/generated/reshape_c16.c b/libgfortran/generated/reshape_c16.c index 79745f2de58..968fb9c34ce 100644 --- a/libgfortran/generated/reshape_c16.c +++ b/libgfortran/generated/reshape_c16.c @@ -137,7 +137,7 @@ reshape_c16 (gfc_array_c16 * const restrict ret, source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; - if (rs != source_extent) + if (rs < source_extent || (rs > source_extent && !pad)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -262,16 +262,16 @@ reshape_c16 (gfc_array_c16 * const restrict ret, if (sempty) { - /* Switch immediately to the pad array. */ + /* Pretend we are using the pad array the first time around, too. */ src = pptr; - sptr = NULL; + sptr = pptr; 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); + sstride0 = pstride[0]; } } diff --git a/libgfortran/generated/reshape_c4.c b/libgfortran/generated/reshape_c4.c index 90383adf922..00c95e7787c 100644 --- a/libgfortran/generated/reshape_c4.c +++ b/libgfortran/generated/reshape_c4.c @@ -137,7 +137,7 @@ reshape_c4 (gfc_array_c4 * const restrict ret, source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; - if (rs != source_extent) + if (rs < source_extent || (rs > source_extent && !pad)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -262,16 +262,16 @@ reshape_c4 (gfc_array_c4 * const restrict ret, if (sempty) { - /* Switch immediately to the pad array. */ + /* Pretend we are using the pad array the first time around, too. */ src = pptr; - sptr = NULL; + sptr = pptr; 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); + sstride0 = pstride[0]; } } diff --git a/libgfortran/generated/reshape_c8.c b/libgfortran/generated/reshape_c8.c index 49178e5e09a..9d355a51370 100644 --- a/libgfortran/generated/reshape_c8.c +++ b/libgfortran/generated/reshape_c8.c @@ -137,7 +137,7 @@ reshape_c8 (gfc_array_c8 * const restrict ret, source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; - if (rs != source_extent) + if (rs < source_extent || (rs > source_extent && !pad)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -262,16 +262,16 @@ reshape_c8 (gfc_array_c8 * const restrict ret, if (sempty) { - /* Switch immediately to the pad array. */ + /* Pretend we are using the pad array the first time around, too. */ src = pptr; - sptr = NULL; + sptr = pptr; 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); + sstride0 = pstride[0]; } } diff --git a/libgfortran/generated/reshape_i16.c b/libgfortran/generated/reshape_i16.c index a6264651365..28885115569 100644 --- a/libgfortran/generated/reshape_i16.c +++ b/libgfortran/generated/reshape_i16.c @@ -137,7 +137,7 @@ reshape_16 (gfc_array_i16 * const restrict ret, source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; - if (rs != source_extent) + if (rs < source_extent || (rs > source_extent && !pad)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -262,16 +262,16 @@ reshape_16 (gfc_array_i16 * const restrict ret, if (sempty) { - /* Switch immediately to the pad array. */ + /* Pretend we are using the pad array the first time around, too. */ src = pptr; - sptr = NULL; + sptr = pptr; 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); + sstride0 = pstride[0]; } } diff --git a/libgfortran/generated/reshape_i4.c b/libgfortran/generated/reshape_i4.c index 1d3aa49e947..021ecfbc314 100644 --- a/libgfortran/generated/reshape_i4.c +++ b/libgfortran/generated/reshape_i4.c @@ -137,7 +137,7 @@ reshape_4 (gfc_array_i4 * const restrict ret, source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; - if (rs != source_extent) + if (rs < source_extent || (rs > source_extent && !pad)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -262,16 +262,16 @@ reshape_4 (gfc_array_i4 * const restrict ret, if (sempty) { - /* Switch immediately to the pad array. */ + /* Pretend we are using the pad array the first time around, too. */ src = pptr; - sptr = NULL; + sptr = pptr; 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); + sstride0 = pstride[0]; } } diff --git a/libgfortran/generated/reshape_i8.c b/libgfortran/generated/reshape_i8.c index 8c51795f1ff..9a2ce8d45dd 100644 --- a/libgfortran/generated/reshape_i8.c +++ b/libgfortran/generated/reshape_i8.c @@ -137,7 +137,7 @@ reshape_8 (gfc_array_i8 * const restrict ret, source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; - if (rs != source_extent) + if (rs < source_extent || (rs > source_extent && !pad)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -262,16 +262,16 @@ reshape_8 (gfc_array_i8 * const restrict ret, if (sempty) { - /* Switch immediately to the pad array. */ + /* Pretend we are using the pad array the first time around, too. */ src = pptr; - sptr = NULL; + sptr = pptr; 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); + sstride0 = pstride[0]; } } diff --git a/libgfortran/generated/reshape_r10.c b/libgfortran/generated/reshape_r10.c index 846d12f1f08..100173f70d0 100644 --- a/libgfortran/generated/reshape_r10.c +++ b/libgfortran/generated/reshape_r10.c @@ -137,7 +137,7 @@ reshape_r10 (gfc_array_r10 * const restrict ret, source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; - if (rs != source_extent) + if (rs < source_extent || (rs > source_extent && !pad)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -262,16 +262,16 @@ reshape_r10 (gfc_array_r10 * const restrict ret, if (sempty) { - /* Switch immediately to the pad array. */ + /* Pretend we are using the pad array the first time around, too. */ src = pptr; - sptr = NULL; + sptr = pptr; 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); + sstride0 = pstride[0]; } } diff --git a/libgfortran/generated/reshape_r16.c b/libgfortran/generated/reshape_r16.c index 286e374ff18..8a344e0b6ba 100644 --- a/libgfortran/generated/reshape_r16.c +++ b/libgfortran/generated/reshape_r16.c @@ -137,7 +137,7 @@ reshape_r16 (gfc_array_r16 * const restrict ret, source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; - if (rs != source_extent) + if (rs < source_extent || (rs > source_extent && !pad)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -262,16 +262,16 @@ reshape_r16 (gfc_array_r16 * const restrict ret, if (sempty) { - /* Switch immediately to the pad array. */ + /* Pretend we are using the pad array the first time around, too. */ src = pptr; - sptr = NULL; + sptr = pptr; 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); + sstride0 = pstride[0]; } } diff --git a/libgfortran/generated/reshape_r4.c b/libgfortran/generated/reshape_r4.c index cd16b24a9eb..ea8c24a2b66 100644 --- a/libgfortran/generated/reshape_r4.c +++ b/libgfortran/generated/reshape_r4.c @@ -137,7 +137,7 @@ reshape_r4 (gfc_array_r4 * const restrict ret, source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; - if (rs != source_extent) + if (rs < source_extent || (rs > source_extent && !pad)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -262,16 +262,16 @@ reshape_r4 (gfc_array_r4 * const restrict ret, if (sempty) { - /* Switch immediately to the pad array. */ + /* Pretend we are using the pad array the first time around, too. */ src = pptr; - sptr = NULL; + sptr = pptr; 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); + sstride0 = pstride[0]; } } diff --git a/libgfortran/generated/reshape_r8.c b/libgfortran/generated/reshape_r8.c index 9da26d4c199..d8855e7874e 100644 --- a/libgfortran/generated/reshape_r8.c +++ b/libgfortran/generated/reshape_r8.c @@ -137,7 +137,7 @@ reshape_r8 (gfc_array_r8 * const restrict ret, source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; - if (rs != source_extent) + if (rs < source_extent || (rs > source_extent && !pad)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -262,16 +262,16 @@ reshape_r8 (gfc_array_r8 * const restrict ret, if (sempty) { - /* Switch immediately to the pad array. */ + /* Pretend we are using the pad array the first time around, too. */ src = pptr; - sptr = NULL; + sptr = pptr; 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); + sstride0 = pstride[0]; } } diff --git a/libgfortran/intrinsics/reshape_generic.c b/libgfortran/intrinsics/reshape_generic.c index 2d8306cbe31..04b87271e9b 100644 --- a/libgfortran/intrinsics/reshape_generic.c +++ b/libgfortran/intrinsics/reshape_generic.c @@ -126,7 +126,7 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; - if (rs != source_extent) + if (rs < source_extent || (rs > source_extent && !pad)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -249,16 +249,16 @@ reshape_internal (parray *ret, parray *source, shape_type *shape, if (sempty) { - /* Switch immediately to the pad array. */ + /* Pretend we are using the pad array the first time around, too. */ src = pptr; - sptr = NULL; + sptr = pptr; sdim = pdim; for (dim = 0; dim < pdim; dim++) { scount[dim] = pcount[dim]; sextent[dim] = pextent[dim]; sstride[dim] = pstride[dim]; - sstride0 = sstride[0] * size; + sstride0 = pstride[0] * size; } } diff --git a/libgfortran/m4/reshape.m4 b/libgfortran/m4/reshape.m4 index 8d7ea728086..b7e321e3bb4 100644 --- a/libgfortran/m4/reshape.m4 +++ b/libgfortran/m4/reshape.m4 @@ -141,7 +141,7 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound; - if (rs != source_extent) + if (rs < source_extent || (rs > source_extent && !pad)) runtime_error("Incorrect size in SOURCE argument to RESHAPE" " intrinsic: is %ld, should be %ld", (long int) source_extent, (long int) rs); @@ -266,16 +266,16 @@ reshape_'rtype_ccode` ('rtype` * const restrict ret, if (sempty) { - /* Switch immediately to the pad array. */ + /* Pretend we are using the pad array the first time around, too. */ src = pptr; - sptr = NULL; + sptr = pptr; 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`); + sstride0 = pstride[0]; } } -- 2.11.0