[gcc] GCC 4.5.0=>4.5.1

gcc/libgfortran/intrinsics/unpack_generic.c

Index: gcc/libgfortran/intrinsics/unpack_generic.c
diff --git a/gcc/libgfortran/intrinsics/unpack_generic.c b/gcc/libgfortran/intrinsics/unpack_generic.c
index a27e37c7272e71a6630fed068d2565d0de9a33aa..2dcef78001e8daa974c4bdc73f01bc2640f72788 100644
--- a/gcc/libgfortran/intrinsics/unpack_generic.c
+++ b/gcc/libgfortran/intrinsics/unpack_generic.c
@@ -28,10 +28,36 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include <assert.h>
 #include <string.h>
 
+/* All the bounds checking for unpack in one function.  If field is NULL,
+   we don't check it, for the unpack0 functions.  */
+
+static void
+unpack_bounds (gfc_array_char *ret, const gfc_array_char *vector,
+	 const gfc_array_l1 *mask, const gfc_array_char *field)
+{
+  index_type vec_size, mask_count;
+  vec_size = size0 ((array_t *) vector);
+  mask_count = count_0 (mask);
+  if (vec_size < mask_count)
+    runtime_error ("Incorrect size of return value in UNPACK"
+		   " intrinsic: should be at least %ld, is"
+		   " %ld", (long int) mask_count,
+		   (long int) vec_size);
+
+  if (field != NULL)
+    bounds_equal_extents ((array_t *) field, (array_t *) mask,
+			  "FIELD", "UNPACK");
+
+  if (ret->data != NULL)
+    bounds_equal_extents ((array_t *) ret, (array_t *) mask,
+			  "return value", "UNPACK");
+
+}
+
 static void
 unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
 		 const gfc_array_l1 *mask, const gfc_array_char *field,
-		 index_type size, index_type fsize)
+		 index_type size)
 {
   /* r.* indicates the return array.  */
   index_type rstride[GFC_MAX_DIMENSIONS];
@@ -89,14 +115,13 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
       for (n = 0; n < dim; n++)
 	{
 	  count[n] = 0;
-	  ret->dim[n].stride = rs;
-	  ret->dim[n].lbound = 0;
-	  ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound;
-	  extent[n] = ret->dim[n].ubound + 1;
+	  GFC_DIMENSION_SET(ret->dim[n], 0,
+			    GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs);
+	  extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
 	  empty = empty || extent[n] <= 0;
-	  rstride[n] = ret->dim[n].stride * size;
-	  fstride[n] = field->dim[n].stride * fsize;
-	  mstride[n] = mask->dim[n].stride * mask_kind;
+	  rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n);
+	  fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n);
+	  mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n);
 	  rs *= extent[n];
 	}
       ret->offset = 0;
@@ -108,27 +133,18 @@ unpack_internal (gfc_array_char *ret, const gfc_array_char *vector,
       for (n = 0; n < dim; n++)
 	{
 	  count[n] = 0;
-	  extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+	  extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n);
 	  empty = empty || extent[n] <= 0;
-	  rstride[n] = ret->dim[n].stride * size;
-	  fstride[n] = field->dim[n].stride * fsize;
-	  mstride[n] = mask->dim[n].stride * mask_kind;
+	  rstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(ret, n);
+	  fstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(field, n);
+	  mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n);
 	}
-      if (rstride[0] == 0)
-	rstride[0] = size;
     }
 
   if (empty)
     return;
 
-  if (fstride[0] == 0)
-    fstride[0] = fsize;
-  if (mstride[0] == 0)
-    mstride[0] = 1;
-
-  vstride0 = vector->dim[0].stride * size;
-  if (vstride0 == 0)
-    vstride0 = size;
+  vstride0 = GFC_DESCRIPTOR_STRIDE_BYTES(vector,0);
   rstride0 = rstride[0];
   fstride0 = fstride[0];
   mstride0 = mstride[0];
@@ -194,6 +210,9 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
   index_type type_size;
   index_type size;
 
+  if (unlikely(compile_options.bounds_check))
+    unpack_bounds (ret, vector, mask, field);
+
   type_size = GFC_DTYPE_TYPE_SIZE (vector);
   size = GFC_DESCRIPTOR_SIZE (vector);
 
@@ -326,8 +345,7 @@ unpack1 (gfc_array_char *ret, const gfc_array_char *vector,
 #endif
     }
 
-  unpack_internal (ret, vector, mask, field, size,
-		   GFC_DESCRIPTOR_SIZE (field));
+  unpack_internal (ret, vector, mask, field, size);
 }
 
 
@@ -342,9 +360,13 @@ unpack1_char (gfc_array_char *ret,
 	      GFC_INTEGER_4 ret_length __attribute__((unused)),
 	      const gfc_array_char *vector, const gfc_array_l1 *mask,
 	      const gfc_array_char *field, GFC_INTEGER_4 vector_length,
-	      GFC_INTEGER_4 field_length)
+	      GFC_INTEGER_4 field_length __attribute__((unused)))
 {
-  unpack_internal (ret, vector, mask, field, vector_length, field_length);
+
+  if (unlikely(compile_options.bounds_check))
+    unpack_bounds (ret, vector, mask, field);
+
+  unpack_internal (ret, vector, mask, field, vector_length);
 }
 
 
@@ -359,11 +381,14 @@ unpack1_char4 (gfc_array_char *ret,
 	       GFC_INTEGER_4 ret_length __attribute__((unused)),
 	       const gfc_array_char *vector, const gfc_array_l1 *mask,
 	       const gfc_array_char *field, GFC_INTEGER_4 vector_length,
-	       GFC_INTEGER_4 field_length)
+	       GFC_INTEGER_4 field_length __attribute__((unused)))
 {
+
+  if (unlikely(compile_options.bounds_check))
+    unpack_bounds (ret, vector, mask, field);
+
   unpack_internal (ret, vector, mask, field,
-		   vector_length * sizeof (gfc_char4_t),
-		   field_length * sizeof (gfc_char4_t));
+		   vector_length * sizeof (gfc_char4_t));
 }
 
 
@@ -378,12 +403,13 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
   gfc_array_char tmp;
 
   index_type type_size;
-  index_type size;
+
+  if (unlikely(compile_options.bounds_check))
+    unpack_bounds (ret, vector, mask, NULL);
 
   type_size = GFC_DTYPE_TYPE_SIZE (vector);
-  size = GFC_DESCRIPTOR_SIZE (vector);
 
-  switch(type_size)
+  switch (type_size)
     {
     case GFC_DTYPE_LOGICAL_1:
     case GFC_DTYPE_INTEGER_1:
@@ -513,7 +539,7 @@ unpack0 (gfc_array_char *ret, const gfc_array_char *vector,
   memset (&tmp, 0, sizeof (tmp));
   tmp.dtype = 0;
   tmp.data = field;
-  unpack_internal (ret, vector, mask, &tmp, GFC_DESCRIPTOR_SIZE (vector), 0);
+  unpack_internal (ret, vector, mask, &tmp, GFC_DESCRIPTOR_SIZE (vector));
 }
 
 
@@ -531,10 +557,13 @@ unpack0_char (gfc_array_char *ret,
 {
   gfc_array_char tmp;
 
+  if (unlikely(compile_options.bounds_check))
+    unpack_bounds (ret, vector, mask, NULL);
+
   memset (&tmp, 0, sizeof (tmp));
   tmp.dtype = 0;
   tmp.data = field;
-  unpack_internal (ret, vector, mask, &tmp, vector_length, 0);
+  unpack_internal (ret, vector, mask, &tmp, vector_length);
 }
 
 
@@ -552,9 +581,12 @@ unpack0_char4 (gfc_array_char *ret,
 {
   gfc_array_char tmp;
 
+  if (unlikely(compile_options.bounds_check))
+    unpack_bounds (ret, vector, mask, NULL);
+
   memset (&tmp, 0, sizeof (tmp));
   tmp.dtype = 0;
   tmp.data = field;
   unpack_internal (ret, vector, mask, &tmp,
-		   vector_length * sizeof (gfc_char4_t), 0);
+		   vector_length * sizeof (gfc_char4_t));
 }