From 3fc453f14bc190b1cfac477f6fdc95edfa7dbf12 Mon Sep 17 00:00:00 2001 From: tkoenig Date: Tue, 21 Oct 2008 20:12:52 +0000 Subject: [PATCH] 2008-10-21 Thomas Koenig 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 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 --- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/transpose_2.f90 | 18 ++++++++++++++++++ libgfortran/ChangeLog | 17 +++++++++++++++++ libgfortran/generated/transpose_c10.c | 22 ++++++++++++++++++++++ libgfortran/generated/transpose_c16.c | 22 ++++++++++++++++++++++ libgfortran/generated/transpose_c4.c | 22 ++++++++++++++++++++++ libgfortran/generated/transpose_c8.c | 22 ++++++++++++++++++++++ libgfortran/generated/transpose_i16.c | 22 ++++++++++++++++++++++ libgfortran/generated/transpose_i4.c | 22 ++++++++++++++++++++++ libgfortran/generated/transpose_i8.c | 22 ++++++++++++++++++++++ libgfortran/generated/transpose_r10.c | 22 ++++++++++++++++++++++ libgfortran/generated/transpose_r16.c | 22 ++++++++++++++++++++++ libgfortran/generated/transpose_r4.c | 22 ++++++++++++++++++++++ libgfortran/generated/transpose_r8.c | 22 ++++++++++++++++++++++ libgfortran/intrinsics/transpose_generic.c | 23 +++++++++++++++++++++++ libgfortran/m4/transpose.m4 | 22 ++++++++++++++++++++++ 16 files changed, 327 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/transpose_2.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ddabb98..b008537 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-10-21 Thomas Koenig + + PR libfortran/34670 + * gfortran.dg/transpose_2.f90: New test. + 2008-10-21 Jakub Jelinek 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 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 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,20 @@ +2008-10-21 Thomas Koenig + + 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 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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; -- 2.7.4