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  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.



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

2 files changed, 82 insertions, 0 deletions

diff --git a/libgfortran/m4/matmul.m4 b/libgfortran/m4/matmul.m4
index 181efa3b654..a43b430c2e3 100644
--- a/libgfortran/m4/matmul.m4
+++ b/libgfortran/m4/matmul.m4
@@ -136,6 +136,47 @@ matmul_'rtype_code` ('rtype` * const restrict retarray,
 	= 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
 `
diff --git a/libgfortran/m4/matmull.m4 b/libgfortran/m4/matmull.m4
index 54afa8a238e..800444564f7 100644
--- a/libgfortran/m4/matmull.m4
+++ b/libgfortran/m4/matmull.m4
@@ -100,6 +100,47 @@ matmul_'rtype_code` ('rtype` * const restrict retarray,
 	= 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);