/* Implementation of the TRANSPOSE intrinsic
- Copyright 2003, 2005 Free Software Foundation, Inc.
+ Copyright 2003, 2005, 2006, 2007 Free Software Foundation, Inc.
Contributed by Tobias Schlüter
This file is part of the GNU Fortran 95 runtime library (libgfortran).
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
-#include "config.h"
-#include <assert.h>
#include "libgfortran.h"
+#include <assert.h>
+
#if defined (HAVE_GFC_COMPLEX_10)
-extern void transpose_c10 (gfc_array_c10 * ret, gfc_array_c10 * source);
+extern void transpose_c10 (gfc_array_c10 * const restrict ret,
+ gfc_array_c10 * const restrict source);
export_proto(transpose_c10);
void
-transpose_c10 (gfc_array_c10 * ret, gfc_array_c10 * source)
+transpose_c10 (gfc_array_c10 * const restrict ret,
+ gfc_array_c10 * const restrict source)
{
/* r.* indicates the return array. */
index_type rxstride, rystride;
- GFC_COMPLEX_10 *rptr;
+ GFC_COMPLEX_10 * restrict rptr;
/* s.* indicates the source array. */
index_type sxstride, systride;
const GFC_COMPLEX_10 *sptr;
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;
- if (ret->dim[0].stride == 0)
- ret->dim[0].stride = 1;
- if (source->dim[0].stride == 0)
- source->dim[0].stride = 1;
+ 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;
systride = source->dim[1].stride;