OSDN Git Service

2008-11-18 Thomas Koenig <tkoenig@gcc.gnu.org>
[pf3gnuchains/gcc-fork.git] / libgfortran / generated / reshape_i16.c
index e2d5a27..2888511 100644 (file)
@@ -119,6 +119,54 @@ reshape_16 (gfc_array_i16 * const restrict ret,
   if (shape_empty)
     return;
 
+  if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, source_extent;
+
+      rs = 1;
+      for (n = 0; n < rdim; n++)
+       {
+         rs *= shape_data[n];
+         ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+         if (ret_extent != shape_data[n])
+           runtime_error("Incorrect extent in return value of RESHAPE"
+                         " intrinsic in dimension %ld: is %ld,"
+                         " should be %ld", (long int) n+1,
+                         (long int) ret_extent, (long int) shape_data[n]);
+       }
+
+      source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      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);
+
+      if (order)
+       {
+         int seen[GFC_MAX_DIMENSIONS];
+         index_type v;
+
+         for (n = 0; n < rdim; n++)
+           seen[n] = 0;
+
+         for (n = 0; n < rdim; n++)
+           {
+             v = order->data[n * order->dim[0].stride] - 1;
+
+             if (v < 0 || v >= rdim)
+               runtime_error("Value %ld out of range in ORDER argument"
+                             " to RESHAPE intrinsic", (long int) v + 1);
+
+             if (seen[v] != 0)
+               runtime_error("Duplicate value %ld in ORDER argument to"
+                             " RESHAPE intrinsic", (long int) v + 1);
+               
+             seen[v] = 1;
+           }
+       }
+    }
+
   rsize = 1;
   for (n = 0; n < rdim; n++)
     {
@@ -214,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];
        }
     }