OSDN Git Service

2008-07-07 Thomas Koenig <tkoenig@gcc.gnu.org>
authortkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 7 Jul 2008 19:43:33 +0000 (19:43 +0000)
committertkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 7 Jul 2008 19:43:33 +0000 (19:43 +0000)
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

24 files changed:
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/generated/matmul_c10.c
libgfortran/generated/matmul_c16.c
libgfortran/generated/matmul_c4.c
libgfortran/generated/matmul_c8.c
libgfortran/generated/matmul_i1.c
libgfortran/generated/matmul_i16.c
libgfortran/generated/matmul_i2.c
libgfortran/generated/matmul_i4.c
libgfortran/generated/matmul_i8.c
libgfortran/generated/matmul_l16.c
libgfortran/generated/matmul_l4.c
libgfortran/generated/matmul_l8.c
libgfortran/generated/matmul_r10.c
libgfortran/generated/matmul_r16.c
libgfortran/generated/matmul_r4.c
libgfortran/generated/matmul_r8.c
libgfortran/m4/matmul.m4
libgfortran/m4/matmull.m4

index b212e44..143f75d 100644 (file)
@@ -1,3 +1,12 @@
+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.
diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_2.f90
new file mode 100644 (file)
index 0000000..429b28c
--- /dev/null
@@ -0,0 +1,16 @@
+! { 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" }
diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_3.f90
new file mode 100644 (file)
index 0000000..c5830de
--- /dev/null
@@ -0,0 +1,16 @@
+! { 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" }
diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_4.f90
new file mode 100644 (file)
index 0000000..a61bacc
--- /dev/null
@@ -0,0 +1,16 @@
+! { 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" }
diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_5.f90
new file mode 100644 (file)
index 0000000..4b20098
--- /dev/null
@@ -0,0 +1,16 @@
+! { 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" }
index 18bd7b1..c845606 100644 (file)
@@ -1,3 +1,26 @@
+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
index 08c2044..0e37862 100644 (file)
@@ -135,6 +135,47 @@ matmul_c10 (gfc_array_c10 * const restrict retarray,
        = 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)
index 6a2a639..34cc51d 100644 (file)
@@ -135,6 +135,47 @@ matmul_c16 (gfc_array_c16 * const restrict retarray,
        = 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)
index 6dcf6fe..fdfea1d 100644 (file)
@@ -135,6 +135,47 @@ matmul_c4 (gfc_array_c4 * const restrict retarray,
        = 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)
index 8bc619d..9d66949 100644 (file)
@@ -135,6 +135,47 @@ matmul_c8 (gfc_array_c8 * const restrict retarray,
        = 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)
index ca16ed4..34fd7c5 100644 (file)
@@ -135,6 +135,47 @@ matmul_i1 (gfc_array_i1 * const restrict retarray,
        = 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)
index 33c62ae..0c7c5d8 100644 (file)
@@ -135,6 +135,47 @@ matmul_i16 (gfc_array_i16 * const restrict retarray,
        = 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)
index e3119ac..5d55847 100644 (file)
@@ -135,6 +135,47 @@ matmul_i2 (gfc_array_i2 * const restrict retarray,
        = 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)
index a1b8c50..a80f149 100644 (file)
@@ -135,6 +135,47 @@ matmul_i4 (gfc_array_i4 * const restrict retarray,
        = 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)
index eee73ac..91499c7 100644 (file)
@@ -135,6 +135,47 @@ matmul_i8 (gfc_array_i8 * const restrict retarray,
        = 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)
index b2b86ec..b604edf 100644 (file)
@@ -99,6 +99,47 @@ matmul_l16 (gfc_array_l16 * const restrict retarray,
        = 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);
index 9a6cb1d..5aed0fe 100644 (file)
@@ -99,6 +99,47 @@ matmul_l4 (gfc_array_l4 * const restrict retarray,
        = 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);
index 7d4e35e..26baad3 100644 (file)
@@ -99,6 +99,47 @@ matmul_l8 (gfc_array_l8 * const restrict retarray,
        = 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);
index 58dfe75..931e2bd 100644 (file)
@@ -135,6 +135,47 @@ matmul_r10 (gfc_array_r10 * const restrict retarray,
        = 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)
index a6a93be..16ec175 100644 (file)
@@ -135,6 +135,47 @@ matmul_r16 (gfc_array_r16 * const restrict retarray,
        = 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)
index 1154d41..47d9764 100644 (file)
@@ -135,6 +135,47 @@ matmul_r4 (gfc_array_r4 * const restrict retarray,
        = 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)
index 7bce253..a359ffd 100644 (file)
@@ -135,6 +135,47 @@ matmul_r8 (gfc_array_r8 * const restrict retarray,
        = 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)
index 181efa3..a43b430 100644 (file)
@@ -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
 `
index 54afa8a..8004445 100644 (file)
@@ -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);