re PR libfortran/34670 (bounds checking for array intrinsics)

2008-10-21  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/34670
	* intrinsics/transpose_generic.c:  Implement bounds checking.
	* m4/transpose.m4:  Likewise.
	* generated/transpose_c8.c: Regenerated.
	* generated/transpose_c16.c: Regenerated.
	* generated/transpose_r10.c: Regenerated.
	* generated/transpose_i8.c: Regenerated.
	* generated/transpose_c10.c: Regenerated.
	* generated/transpose_r4.c: Regenerated.
	* generated/transpose_c4.c: Regenerated.
	* generated/transpose_i16.c: Regenerated.
	* generated/transpose_i4.c: Regenerated.
	* generated/transpose_r8.c: Regenerated.
	* generated/transpose_r16.c: Regenerated.

2008-10-21  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/34670
	* gfortran.dg/transpose_2.f90:  New test.

From-SVN: r141276

14 files changed, 304 insertions, 0 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 9b2d18d58cf..3802d69e969 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,20 @@
+2008-10-21  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR libfortran/34670
+	* intrinsics/transpose_generic.c:  Implement bounds checking.
+	* m4/transpose.m4:  Likewise.
+	* generated/transpose_c8.c: Regenerated.
+	* generated/transpose_c16.c: Regenerated.
+	* generated/transpose_r10.c: Regenerated.
+	* generated/transpose_i8.c: Regenerated.
+	* generated/transpose_c10.c: Regenerated.
+	* generated/transpose_r4.c: Regenerated.
+	* generated/transpose_c4.c: Regenerated.
+	* generated/transpose_i16.c: Regenerated.
+	* generated/transpose_i4.c: Regenerated.
+	* generated/transpose_r8.c: Regenerated.
+	* generated/transpose_r16.c: Regenerated.
+
 2008-10-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org
 
 	PR libfortran/37834
diff --git a/libgfortran/generated/transpose_c10.c b/libgfortran/generated/transpose_c10.c
index 72235967b34..65760e28051 100644
--- a/libgfortran/generated/transpose_c10.c
+++ b/libgfortran/generated/transpose_c10.c
@@ -69,6 +69,28 @@ transpose_c10 (gfc_array_c10 * const restrict ret,
 
       ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) ret));
       ret->offset = 0;
+    } else if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, src_extent;
+
+      ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+      src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 1: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+      ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
+      src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 2: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
     }
 
   sxstride = source->dim[0].stride;
diff --git a/libgfortran/generated/transpose_c16.c b/libgfortran/generated/transpose_c16.c
index e3863f1f2ad..94b5b96e3f1 100644
--- a/libgfortran/generated/transpose_c16.c
+++ b/libgfortran/generated/transpose_c16.c
@@ -69,6 +69,28 @@ transpose_c16 (gfc_array_c16 * const restrict ret,
 
       ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) ret));
       ret->offset = 0;
+    } else if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, src_extent;
+
+      ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+      src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 1: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+      ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
+      src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 2: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
     }
 
   sxstride = source->dim[0].stride;
diff --git a/libgfortran/generated/transpose_c4.c b/libgfortran/generated/transpose_c4.c
index cdb5a9a06e1..14cc7cadc62 100644
--- a/libgfortran/generated/transpose_c4.c
+++ b/libgfortran/generated/transpose_c4.c
@@ -69,6 +69,28 @@ transpose_c4 (gfc_array_c4 * const restrict ret,
 
       ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 ((array_t *) ret));
       ret->offset = 0;
+    } else if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, src_extent;
+
+      ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+      src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 1: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+      ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
+      src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 2: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
     }
 
   sxstride = source->dim[0].stride;
diff --git a/libgfortran/generated/transpose_c8.c b/libgfortran/generated/transpose_c8.c
index 91fb1042499..219331ba5f7 100644
--- a/libgfortran/generated/transpose_c8.c
+++ b/libgfortran/generated/transpose_c8.c
@@ -69,6 +69,28 @@ transpose_c8 (gfc_array_c8 * const restrict ret,
 
       ret->data = internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 ((array_t *) ret));
       ret->offset = 0;
+    } else if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, src_extent;
+
+      ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+      src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 1: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+      ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
+      src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 2: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
     }
 
   sxstride = source->dim[0].stride;
diff --git a/libgfortran/generated/transpose_i16.c b/libgfortran/generated/transpose_i16.c
index b7564ad17aa..83d6257b3e2 100644
--- a/libgfortran/generated/transpose_i16.c
+++ b/libgfortran/generated/transpose_i16.c
@@ -69,6 +69,28 @@ transpose_i16 (gfc_array_i16 * const restrict ret,
 
       ret->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) ret));
       ret->offset = 0;
+    } else if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, src_extent;
+
+      ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+      src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 1: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+      ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
+      src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 2: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
     }
 
   sxstride = source->dim[0].stride;
diff --git a/libgfortran/generated/transpose_i4.c b/libgfortran/generated/transpose_i4.c
index 51472fd09a0..f2a79cd02da 100644
--- a/libgfortran/generated/transpose_i4.c
+++ b/libgfortran/generated/transpose_i4.c
@@ -69,6 +69,28 @@ transpose_i4 (gfc_array_i4 * const restrict ret,
 
       ret->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 ((array_t *) ret));
       ret->offset = 0;
+    } else if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, src_extent;
+
+      ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+      src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 1: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+      ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
+      src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 2: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
     }
 
   sxstride = source->dim[0].stride;
diff --git a/libgfortran/generated/transpose_i8.c b/libgfortran/generated/transpose_i8.c
index 37428ddacbd..8c065de9029 100644
--- a/libgfortran/generated/transpose_i8.c
+++ b/libgfortran/generated/transpose_i8.c
@@ -69,6 +69,28 @@ transpose_i8 (gfc_array_i8 * const restrict ret,
 
       ret->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 ((array_t *) ret));
       ret->offset = 0;
+    } else if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, src_extent;
+
+      ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+      src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 1: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+      ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
+      src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 2: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
     }
 
   sxstride = source->dim[0].stride;
diff --git a/libgfortran/generated/transpose_r10.c b/libgfortran/generated/transpose_r10.c
index 32704166b1d..189e0dd726d 100644
--- a/libgfortran/generated/transpose_r10.c
+++ b/libgfortran/generated/transpose_r10.c
@@ -69,6 +69,28 @@ transpose_r10 (gfc_array_r10 * const restrict ret,
 
       ret->data = internal_malloc_size (sizeof (GFC_REAL_10) * size0 ((array_t *) ret));
       ret->offset = 0;
+    } else if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, src_extent;
+
+      ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+      src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 1: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+      ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
+      src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 2: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
     }
 
   sxstride = source->dim[0].stride;
diff --git a/libgfortran/generated/transpose_r16.c b/libgfortran/generated/transpose_r16.c
index 858b3a56555..928b1835533 100644
--- a/libgfortran/generated/transpose_r16.c
+++ b/libgfortran/generated/transpose_r16.c
@@ -69,6 +69,28 @@ transpose_r16 (gfc_array_r16 * const restrict ret,
 
       ret->data = internal_malloc_size (sizeof (GFC_REAL_16) * size0 ((array_t *) ret));
       ret->offset = 0;
+    } else if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, src_extent;
+
+      ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+      src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 1: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+      ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
+      src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 2: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
     }
 
   sxstride = source->dim[0].stride;
diff --git a/libgfortran/generated/transpose_r4.c b/libgfortran/generated/transpose_r4.c
index 1968302dd35..0cb2404b7bd 100644
--- a/libgfortran/generated/transpose_r4.c
+++ b/libgfortran/generated/transpose_r4.c
@@ -69,6 +69,28 @@ transpose_r4 (gfc_array_r4 * const restrict ret,
 
       ret->data = internal_malloc_size (sizeof (GFC_REAL_4) * size0 ((array_t *) ret));
       ret->offset = 0;
+    } else if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, src_extent;
+
+      ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+      src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 1: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+      ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
+      src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 2: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
     }
 
   sxstride = source->dim[0].stride;
diff --git a/libgfortran/generated/transpose_r8.c b/libgfortran/generated/transpose_r8.c
index bbd87649126..78ae4a1a95a 100644
--- a/libgfortran/generated/transpose_r8.c
+++ b/libgfortran/generated/transpose_r8.c
@@ -69,6 +69,28 @@ transpose_r8 (gfc_array_r8 * const restrict ret,
 
       ret->data = internal_malloc_size (sizeof (GFC_REAL_8) * size0 ((array_t *) ret));
       ret->offset = 0;
+    } else if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, src_extent;
+
+      ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+      src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 1: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+      ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
+      src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 2: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
     }
 
   sxstride = source->dim[0].stride;
diff --git a/libgfortran/intrinsics/transpose_generic.c b/libgfortran/intrinsics/transpose_generic.c
index 5b1929ca55d..d51fa310d5a 100644
--- a/libgfortran/intrinsics/transpose_generic.c
+++ b/libgfortran/intrinsics/transpose_generic.c
@@ -68,6 +68,29 @@ transpose_internal (gfc_array_char *ret, gfc_array_char *source,
       ret->data = internal_malloc_size (size * size0 ((array_t*)ret));
       ret->offset = 0;
     }
+  else if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, src_extent;
+
+      ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+      src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 1: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+      ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
+      src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 2: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+    }
 
   sxstride = source->dim[0].stride * size;
   systride = source->dim[1].stride * size;
diff --git a/libgfortran/m4/transpose.m4 b/libgfortran/m4/transpose.m4
index 103cc0296fb..de543eefca7 100644
--- a/libgfortran/m4/transpose.m4
+++ b/libgfortran/m4/transpose.m4
@@ -70,6 +70,28 @@ transpose_'rtype_code` ('rtype` * const restrict ret,
 
       ret->data = internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) ret));
       ret->offset = 0;
+    } else if (unlikely (compile_options.bounds_check))
+    {
+      index_type ret_extent, src_extent;
+
+      ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+      src_extent = source->dim[1].ubound + 1 - source->dim[1].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 1: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
+      ret_extent = ret->dim[1].ubound + 1 - ret->dim[1].lbound;
+      src_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+      if (src_extent != ret_extent)
+	runtime_error ("Incorrect extent in return value of TRANSPOSE"
+		       " intrinsic in dimension 2: is %ld,"
+		       " should be %ld", (long int) src_extent,
+		       (long int) ret_extent);
+
     }
 
   sxstride = source->dim[0].stride;