]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/38135 (RESHAPE gives wrong result)
authorThomas Koenig <tkoenig@gcc.gnu.org>
Tue, 18 Nov 2008 22:43:05 +0000 (22:43 +0000)
committerThomas Koenig <tkoenig@gcc.gnu.org>
Tue, 18 Nov 2008 22:43:05 +0000 (22:43 +0000)
2008-11-18  Thomas Koenig  <tkoenig@gcc.gnu.org>

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  <tkoenig@gcc.gnu.org>

PR libfortran/38135
* gfortran.dg/reshape_pad_1.f90:  New test case.

From-SVN: r141982

16 files changed:
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/reshape_pad_1.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/generated/reshape_c10.c
libgfortran/generated/reshape_c16.c
libgfortran/generated/reshape_c4.c
libgfortran/generated/reshape_c8.c
libgfortran/generated/reshape_i16.c
libgfortran/generated/reshape_i4.c
libgfortran/generated/reshape_i8.c
libgfortran/generated/reshape_r10.c
libgfortran/generated/reshape_r16.c
libgfortran/generated/reshape_r4.c
libgfortran/generated/reshape_r8.c
libgfortran/intrinsics/reshape_generic.c
libgfortran/m4/reshape.m4

index 27c26a315b53abb93a1a53614fc29f05d06d547e..a2b30961fd4671c711ff14be089420a8bf5b1e52 100644 (file)
@@ -1,3 +1,8 @@
+2008-11-18  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR libfortran/38135
+       * gfortran.dg/reshape_pad_1.f90:  New test case.
+
 2008-11-18  Uros Bizjak  <ubizjak@gmail.com>
 
        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 (file)
index 0000000..33afd89
--- /dev/null
@@ -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
index 1fd0263e4806d3f30856d9b170847af810fa75fa..95f526a5374d14c2561a6b1582b6d39f18465eec 100644 (file)
@@ -1,3 +1,21 @@
+2008-11-18  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       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  <jvdelisle@gcc.gnu.org>
 
        PR libfortran/38097
index 567d5b40283e3f5efcd6399426d015666230f9ce..076ea592130dcbe261e0ca024360d6e98cd4bd20 100644 (file)
@@ -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];
        }
     }
 
index 79745f2de5828fb9d19f799534b477efc6ae4f2b..968fb9c34ce88122f21f4cb9d847e2c82f491f68 100644 (file)
@@ -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];
        }
     }
 
index 90383adf922c98aa75edd95dc323302a4ea459e0..00c95e7787cc4420044fbcfe7d4ff8ded8e5b529 100644 (file)
@@ -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];
        }
     }
 
index 49178e5e09adff25df608613ad117e5ad124a245..9d355a51370cdef820a030e76c1b2dd77bba566c 100644 (file)
@@ -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];
        }
     }
 
index a626465136550fb2927370b05a8061d840d7f97d..2888511556974ca3214c206023c510715bee6006 100644 (file)
@@ -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];
        }
     }
 
index 1d3aa49e9470ea6ab7cb9b7069d03bdf3a05bb32..021ecfbc314a43c55972fc1afd674a36972d749d 100644 (file)
@@ -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];
        }
     }
 
index 8c51795f1ff5c908ab933cdfc86cb23e693881e8..9a2ce8d45ddf98d6457f4cdf979fdc4bf84439bb 100644 (file)
@@ -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];
        }
     }
 
index 846d12f1f0826fff43c3fe76a6ee30c400e7cf76..100173f70d0c10ea90f4cd8a013df37c0084ff87 100644 (file)
@@ -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];
        }
     }
 
index 286e374ff18d40b0a54716169dcef7f3e99524ac..8a344e0b6ba86c4223a7daf92a3603678dcce092 100644 (file)
@@ -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];
        }
     }
 
index cd16b24a9eb9c0744cfa4b79e15fabbd6e05fc3b..ea8c24a2b66ebf5d606e31174949619e6a158183 100644 (file)
@@ -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];
        }
     }
 
index 9da26d4c199413ec3ed27af5807cb65823f7f7ca..d8855e7874e60257cc93acca1a619b8262a4bf50 100644 (file)
@@ -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];
        }
     }
 
index 2d8306cbe31c14607a1867ebccad06e2974d7a93..04b87271e9b502838623f91f6774ead44c84ec50 100644 (file)
@@ -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;
        }
     }
 
index 8d7ea728086b948e942654afae865d38793923ab..b7e321e3bb42a2dfd8ba940320b15030dad3dfb5 100644 (file)
@@ -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];
        }
     }