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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@141276 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ddabb98..b008537 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-10-21  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR libfortran/34670
+       * gfortran.dg/transpose_2.f90:  New test.
+
 2008-10-21  Jakub Jelinek  <jakub@redhat.com>
 
        PR middle-end/37669

diff --git a/gcc/testsuite/gfortran.dg/transpose_2.f90 b/gcc/testsuite/gfortran.dg/transpose_2.f90
new file mode 100644 (file)
index 0000000..d48651a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transpose_2.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in return value of TRANSPOSE intrinsic in dimension 1: is 2, should be 3" }
+program main
+  implicit none
+  character(len=10) :: in
+  real, dimension(:,:), allocatable :: a,b
+  integer :: ax, ay, bx, by
+
+  in = "2 2 3 2"
+  read (unit=in,fmt='(4I2)') ax, ay, bx, by
+  allocate (a(ax,ay))
+  allocate (b(bx,by))
+  a = 1.0
+  b = 2.1
+  b = transpose(a)
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return value of TRANSPOSE intrinsic in dimension 1: is 2, should be 3" }

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 9b2d18d..3802d69 100644 (file)
--- 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 7223596..65760e2 100644 (file)
--- 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 e3863f1..94b5b96 100644 (file)
--- 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 cdb5a9a..14cc7ca 100644 (file)
--- 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 91fb104..219331b 100644 (file)
--- 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 b7564ad..83d6257 100644 (file)
--- 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 51472fd..f2a79cd 100644 (file)
--- 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 37428dd..8c065de 100644 (file)
--- 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 3270416..189e0dd 100644 (file)
--- 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 858b3a5..928b183 100644 (file)
--- 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 1968302..0cb2404 100644 (file)
--- 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 bbd8764..78ae4a1 100644 (file)
--- 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 5b1929c..d51fa31 100644 (file)
--- 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 103cc02..de543ee 100644 (file)
--- 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;