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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8feb7befa894d70d79601b9d4840b6de8d9d1024..a83c305a3936b893a4e2ca6b90474f3ddaeff124 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-11-23  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR libfortran/38234
+       * gfortran.dg/reshape_4.f90:  New test.
+
 2008-11-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR libfortran/38225

diff --git a/gcc/testsuite/gfortran.dg/reshape_4.f90 b/gcc/testsuite/gfortran.dg/reshape_4.f90
new file mode 100644 (file)
index 0000000..92208e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/reshape_4.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+program main
+  real, dimension(2,2) :: result
+  real, dimension(6) :: source
+  real, dimension(2) :: pad
+
+  call random_number (source)
+  call random_number (pad)
+
+  result = reshape(source, shape(result),pad=pad(1:0))
+  result = reshape(source, shape(result))
+  result = reshape(source, shape(result),pad=pad)
+
+end program main

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 353b88433c0d04580f2c98d0edcd4fb1f9a5317f..36c0098cab28c66193214a6e46b285588f06e20e 100644 (file)
--- 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 33059948a64dc6c09cd632ecc9384f53d1c85d20..53e59dbda844b3d4a1ffb542c054135f88ded5d9 100644 (file)
--- 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 3b026a5028b377b012353e7a4542cb99c801a114..19cfdfcc31c4ad21bb7dbbbd18b59a125b396b29 100644 (file)
--- 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 1c4740c7f0b49da10ff9c4e8dee26fd47cd9e210..64156d938ea866062d3025c65713cc634648da05 100644 (file)
--- 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 d68ea481ad3b0cda8820cf3f8e91eb781dd7d2fa..5ba646ce112b39b9ef0032601850678a2ac786bb 100644 (file)
--- 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 f46d7586dfc2bff7c13321de51a14f031af04126..81223eae6706094dddc5dab99ad3f526d13c10b9 100644 (file)
--- 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 d868c936cc28ca430dca1eafe415e3d2950c5eae..911f2d7a902f4ac6dd8c6a23a40c2b5bcc613709 100644 (file)
--- 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 bcd984f139750fa13fe1692292516a69e9abf123..b5f9c1e19fc32df4044a1b9c58b6f1c1226f0a37 100644 (file)
--- 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 ac029593d98a1a761faed7130c71f5e92e633644..57dca1aa88816a10232c0ee01b33099b083bfee0 100644 (file)
--- 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 c12fab5c399baf1f97535347c05ddf5d02dfb80c..4509df5b2bb841d17fda9c64bdbb5285cd601b99 100644 (file)
--- 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 aa4bdec70d434a17f93d347fa7a97a0728696d18..c9135577cbd0f1845ad308148eae71dbd01c2c92 100644 (file)
--- 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 bacaaac05bccf2126b41ef2875c56f08017c2f0f..33ce1f0bfbb0aa36c98c2ec6641824a7f7e9a229 100644 (file)
--- 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 8e1fedb7a99c28e97f4dcf1c923baa777341d8ab..e1cc92abaf1b88635145e2d0dfb3844b7aa0b63e 100644 (file)
--- 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 aa5d42960f7399b7f49eaa09fab31cc97f9541a1..53a626e1cee45dc13703d1770254c9e97aab701a 100644 (file)
--- 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`);