+2008-07-07 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/36341
+ PR fortran/34670
+ * gfortran.dg/matmul_bounds_2.f90: New test.
+ * gfortran.dg/matmul_bounds_3.f90: New test.
+ * gfortran.dg/matmul_bounds_4.f90: New test.
+ * gfortran.dg/matmul_bounds_5.f90: New test.
+
2008-07-07 Richard Guenther <rguenther@suse.de>
* gcc.dg/torture/pta-ptrarith-1.c: New testcase.
--- /dev/null
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 2: is 2, should be 3" }
+program main
+ real, dimension(3,2) :: a
+ real, dimension(2,3) :: b
+ real, dimension(:,:), allocatable :: ret
+ allocate (ret(2,2))
+ a = 1.0
+ b = 2.3
+ ret = matmul(b,a) ! This is OK
+ deallocate(ret)
+ allocate(ret(3,2))
+ ret = matmul(a,b) ! This should throw an error.
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 2: is 2, should be 3" }
--- /dev/null
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 1: is 2, should be 3" }
+program main
+ real, dimension(3,2) :: a
+ real, dimension(2,3) :: b
+ real, dimension(:,:), allocatable :: ret
+ allocate (ret(3,3))
+ a = 1.0
+ b = 2.3
+ ret = matmul(a,b) ! This is OK
+ deallocate(ret)
+ allocate(ret(2,3))
+ ret = matmul(a,b) ! This should throw an error.
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 1: is 2, should be 3" }
--- /dev/null
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" }
+program main
+ real, dimension(3) :: a
+ real, dimension(3,2) :: b
+ real, dimension(:), allocatable :: ret
+ allocate (ret(2))
+ a = 1.0
+ b = 2.3
+ ret = matmul(a,b) ! This is OK
+ deallocate(ret)
+ allocate(ret(3))
+ ret = matmul(a,b) ! This should throw an error.
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" }
--- /dev/null
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" }
+program main
+ real, dimension(2,3) :: a
+ real, dimension(3) :: b
+ real, dimension(:), allocatable :: ret
+ allocate (ret(2))
+ a = 1.0
+ b = 2.3
+ ret = matmul(a,b) ! This is OK
+ deallocate(ret)
+ allocate(ret(3))
+ ret = matmul(a,b) ! This should throw an error.
+end program main
+! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" }
+2008-07-07 Thomas Koenig <tkoenig@gcc.gnu.org>
+
+ PR fortran/36341
+ PR fortran/34670
+ * m4/matmul.m4: Add bounds checking.
+ * m4/matmull.m4: Likewise.
+ * generated/matmul_c10.c: Regenerated.
+ * generated/matmul_c16.c: Regenerated.
+ * generated/matmul_c4.c: Regenerated.
+ * generated/matmul_c8.c: Regenerated.
+ * generated/matmul_i1.c: Regenerated.
+ * generated/matmul_i16.c: Regenerated.
+ * generated/matmul_i2.c: Regenerated.
+ * generated/matmul_i4.c: Regenerated.
+ * generated/matmul_i8.c: Regenerated.
+ * generated/matmul_l16.c: Regenerated.
+ * generated/matmul_l4.c: Regenerated.
+ * generated/matmul_l8.c: Regenerated.
+ * generated/matmul_r10.c: Regenerated.
+ * generated/matmul_r16.c: Regenerated.
+ * generated/matmul_r4.c: Regenerated.
+ * generated/matmul_r8.c: Regenerated.
+
2008-07-07 Ralf Wildenhues <Ralf.Wildenhues@gmx.de>
* acinclude.m4 (LIBGFOR_CHECK_GTHR_DEFAULT): Fix configure cache
= internal_malloc_size (sizeof (GFC_COMPLEX_10) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
= internal_malloc_size (sizeof (GFC_COMPLEX_16) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
= internal_malloc_size (sizeof (GFC_COMPLEX_4) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
= internal_malloc_size (sizeof (GFC_COMPLEX_8) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
= internal_malloc_size (sizeof (GFC_INTEGER_1) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
= internal_malloc_size (sizeof (GFC_INTEGER_16) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
= internal_malloc_size (sizeof (GFC_INTEGER_2) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
= internal_malloc_size (sizeof (GFC_INTEGER_4) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
= internal_malloc_size (sizeof (GFC_INTEGER_8) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
= internal_malloc_size (sizeof (GFC_LOGICAL_16) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
abase = a->data;
a_kind = GFC_DESCRIPTOR_SIZE (a);
= internal_malloc_size (sizeof (GFC_LOGICAL_4) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
abase = a->data;
a_kind = GFC_DESCRIPTOR_SIZE (a);
= internal_malloc_size (sizeof (GFC_LOGICAL_8) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
abase = a->data;
a_kind = GFC_DESCRIPTOR_SIZE (a);
= internal_malloc_size (sizeof (GFC_REAL_10) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
= internal_malloc_size (sizeof (GFC_REAL_16) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
= internal_malloc_size (sizeof (GFC_REAL_4) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
= internal_malloc_size (sizeof (GFC_REAL_8) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
if (GFC_DESCRIPTOR_RANK (retarray) == 1)
= internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
'
sinclude(`matmul_asm_'rtype_code`.m4')dnl
`
= internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
abase = a->data;
a_kind = GFC_DESCRIPTOR_SIZE (a);
projects / thirdparty / gcc.git / commitdiff
