re PR fortran/28947 (Double MATMUL() uses wrong array elements)

2006-09-10  Paul Thomas  <pault@gcc.gnu.org>

	PR libfortran/28947
	* m4/matmul.m4: For the case where the second input argument is
	transposed, ensure that the case with rank (a) == 1 is
	correctly calculated.
	* generated/matmul_r4.c: Regenerate.
	* generated/matmul_r8.c: Regenerate.
	* generated/matmul_r10.c: Regenerate.
	* generated/matmul_r16.c: Regenerate.
	* generated/matmul_c4.c: Regenerate.
	* generated/matmul_c8.c: Regenerate.
	* generated/matmul_c10.c: Regenerate.
	* generated/matmul_c16.c: Regenerate.
	* generated/matmul_i4.c: Regenerate.
	* generated/matmul_i8.c: Regenerate.
	* generated/matmul_i16.c: Regenerate.

2006-09-10  Paul Thomas  <pault@gcc.gnu.org>

	PR libfortran/28947
	gfortran.dg/matmul_4.f90: New test.

From-SVN: r116817

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c482122..327a048 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2006-09-10  Paul Thomas  <pault@gcc.gnu.org>
 
+       PR libfortran/28947
+       gfortran.dg/matmul_4.f90: New test.
+
+2006-09-10  Paul Thomas  <pault@gcc.gnu.org>
+
        PR fortran/28959
        gfortran.dg/used_types_10: New test.
 

diff --git a/gcc/testsuite/gfortran.dg/matmul_4.f90 b/gcc/testsuite/gfortran.dg/matmul_4.f90
new file mode 100644 (file)
index 0000000..8bbaef9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/matmul_4.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! Check the fix for PR28947, in which the mechanism for dealing
+! with matmul (a, transpose (b)) would cause wrong results for
+! a having a rank == 1.
+!
+! Contributed by Harald Anlauf  <anlauf@gmx.de>
+!   
+program gfcbug40
+  implicit none
+
+  real :: h(3,3), mat(2,3)
+
+  h(:,:) = - HUGE (1.0)/4       ! Preset unused elements suitably...
+
+  h(3,:) = 0
+  h(3,3) = 1
+  mat(:,:) = 1
+  h(3,:) = h(3,:) + matmul (matmul (h(3,:), transpose (mat)), mat)
+
+  if (any (h(3,:) .ne. (/2.0, 2.0, 3.0/))) call abort ()
+
+end program gfcbug40

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 7151344..edba622 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,21 @@
+2006-09-10  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR libfortran/28947
+       * m4/matmul.m4: For the case where the second input argument is
+       transposed, ensure that the case with rank (a) == 1 is
+       correctly calculated.
+       * generated/matmul_r4.c: Regenerate.
+       * generated/matmul_r8.c: Regenerate.
+       * generated/matmul_r10.c: Regenerate.
+       * generated/matmul_r16.c: Regenerate.
+       * generated/matmul_c4.c: Regenerate.
+       * generated/matmul_c8.c: Regenerate.
+       * generated/matmul_c10.c: Regenerate.
+       * generated/matmul_c16.c: Regenerate.
+       * generated/matmul_i4.c: Regenerate.
+       * generated/matmul_i8.c: Regenerate.
+       * generated/matmul_i16.c: Regenerate.
+
 2006-08-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libgfortran/28354

diff --git a/libgfortran/generated/matmul_c10.c b/libgfortran/generated/matmul_c10.c
index 7b67ddd..df2cd93 100644 (file)
--- a/libgfortran/generated/matmul_c10.c
+++ b/libgfortran/generated/matmul_c10.c
@@ -258,6 +258,20 @@ matmul_c10 (gfc_array_c10 * const restrict retarray,
            /* dest[x,y] += a[x,n] * b[n,y] */
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
+  else if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      const GFC_COMPLEX_10 *restrict bbase_y;
+      GFC_COMPLEX_10 s;
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = &bbase[y*bystride];
+         s = (GFC_COMPLEX_10) 0;
+         for (n = 0; n < count; n++)
+           s += abase[n*axstride] * bbase_y[n*bxstride];
+         dest[y*rxstride] = s;
+       }
+    }
   else
     {
       const GFC_COMPLEX_10 *restrict abase_x;

diff --git a/libgfortran/generated/matmul_c16.c b/libgfortran/generated/matmul_c16.c
index c17bcaa..6425eb8 100644 (file)
--- a/libgfortran/generated/matmul_c16.c
+++ b/libgfortran/generated/matmul_c16.c
@@ -258,6 +258,20 @@ matmul_c16 (gfc_array_c16 * const restrict retarray,
            /* dest[x,y] += a[x,n] * b[n,y] */
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
+  else if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      const GFC_COMPLEX_16 *restrict bbase_y;
+      GFC_COMPLEX_16 s;
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = &bbase[y*bystride];
+         s = (GFC_COMPLEX_16) 0;
+         for (n = 0; n < count; n++)
+           s += abase[n*axstride] * bbase_y[n*bxstride];
+         dest[y*rxstride] = s;
+       }
+    }
   else
     {
       const GFC_COMPLEX_16 *restrict abase_x;

diff --git a/libgfortran/generated/matmul_c4.c b/libgfortran/generated/matmul_c4.c
index d85bd27..2d47a13 100644 (file)
--- a/libgfortran/generated/matmul_c4.c
+++ b/libgfortran/generated/matmul_c4.c
@@ -258,6 +258,20 @@ matmul_c4 (gfc_array_c4 * const restrict retarray,
            /* dest[x,y] += a[x,n] * b[n,y] */
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
+  else if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      const GFC_COMPLEX_4 *restrict bbase_y;
+      GFC_COMPLEX_4 s;
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = &bbase[y*bystride];
+         s = (GFC_COMPLEX_4) 0;
+         for (n = 0; n < count; n++)
+           s += abase[n*axstride] * bbase_y[n*bxstride];
+         dest[y*rxstride] = s;
+       }
+    }
   else
     {
       const GFC_COMPLEX_4 *restrict abase_x;

diff --git a/libgfortran/generated/matmul_c8.c b/libgfortran/generated/matmul_c8.c
index be4ee6c..f22719d 100644 (file)
--- a/libgfortran/generated/matmul_c8.c
+++ b/libgfortran/generated/matmul_c8.c
@@ -258,6 +258,20 @@ matmul_c8 (gfc_array_c8 * const restrict retarray,
            /* dest[x,y] += a[x,n] * b[n,y] */
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
+  else if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      const GFC_COMPLEX_8 *restrict bbase_y;
+      GFC_COMPLEX_8 s;
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = &bbase[y*bystride];
+         s = (GFC_COMPLEX_8) 0;
+         for (n = 0; n < count; n++)
+           s += abase[n*axstride] * bbase_y[n*bxstride];
+         dest[y*rxstride] = s;
+       }
+    }
   else
     {
       const GFC_COMPLEX_8 *restrict abase_x;

diff --git a/libgfortran/generated/matmul_i16.c b/libgfortran/generated/matmul_i16.c
index c4de78a..73c3fbc 100644 (file)
--- a/libgfortran/generated/matmul_i16.c
+++ b/libgfortran/generated/matmul_i16.c
@@ -258,6 +258,20 @@ matmul_i16 (gfc_array_i16 * const restrict retarray,
            /* dest[x,y] += a[x,n] * b[n,y] */
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
+  else if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      const GFC_INTEGER_16 *restrict bbase_y;
+      GFC_INTEGER_16 s;
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = &bbase[y*bystride];
+         s = (GFC_INTEGER_16) 0;
+         for (n = 0; n < count; n++)
+           s += abase[n*axstride] * bbase_y[n*bxstride];
+         dest[y*rxstride] = s;
+       }
+    }
   else
     {
       const GFC_INTEGER_16 *restrict abase_x;

diff --git a/libgfortran/generated/matmul_i4.c b/libgfortran/generated/matmul_i4.c
index cd506a0..63bca01 100644 (file)
--- a/libgfortran/generated/matmul_i4.c
+++ b/libgfortran/generated/matmul_i4.c
@@ -258,6 +258,20 @@ matmul_i4 (gfc_array_i4 * const restrict retarray,
            /* dest[x,y] += a[x,n] * b[n,y] */
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
+  else if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      const GFC_INTEGER_4 *restrict bbase_y;
+      GFC_INTEGER_4 s;
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = &bbase[y*bystride];
+         s = (GFC_INTEGER_4) 0;
+         for (n = 0; n < count; n++)
+           s += abase[n*axstride] * bbase_y[n*bxstride];
+         dest[y*rxstride] = s;
+       }
+    }
   else
     {
       const GFC_INTEGER_4 *restrict abase_x;

diff --git a/libgfortran/generated/matmul_i8.c b/libgfortran/generated/matmul_i8.c
index 7bdfb6f..caaf9e8 100644 (file)
--- a/libgfortran/generated/matmul_i8.c
+++ b/libgfortran/generated/matmul_i8.c
@@ -258,6 +258,20 @@ matmul_i8 (gfc_array_i8 * const restrict retarray,
            /* dest[x,y] += a[x,n] * b[n,y] */
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
+  else if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      const GFC_INTEGER_8 *restrict bbase_y;
+      GFC_INTEGER_8 s;
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = &bbase[y*bystride];
+         s = (GFC_INTEGER_8) 0;
+         for (n = 0; n < count; n++)
+           s += abase[n*axstride] * bbase_y[n*bxstride];
+         dest[y*rxstride] = s;
+       }
+    }
   else
     {
       const GFC_INTEGER_8 *restrict abase_x;

diff --git a/libgfortran/generated/matmul_r10.c b/libgfortran/generated/matmul_r10.c
index 2bdaaf5..8fa1d6d 100644 (file)
--- a/libgfortran/generated/matmul_r10.c
+++ b/libgfortran/generated/matmul_r10.c
@@ -258,6 +258,20 @@ matmul_r10 (gfc_array_r10 * const restrict retarray,
            /* dest[x,y] += a[x,n] * b[n,y] */
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
+  else if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      const GFC_REAL_10 *restrict bbase_y;
+      GFC_REAL_10 s;
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = &bbase[y*bystride];
+         s = (GFC_REAL_10) 0;
+         for (n = 0; n < count; n++)
+           s += abase[n*axstride] * bbase_y[n*bxstride];
+         dest[y*rxstride] = s;
+       }
+    }
   else
     {
       const GFC_REAL_10 *restrict abase_x;

diff --git a/libgfortran/generated/matmul_r16.c b/libgfortran/generated/matmul_r16.c
index f120e7f..0f61b03 100644 (file)
--- a/libgfortran/generated/matmul_r16.c
+++ b/libgfortran/generated/matmul_r16.c
@@ -258,6 +258,20 @@ matmul_r16 (gfc_array_r16 * const restrict retarray,
            /* dest[x,y] += a[x,n] * b[n,y] */
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
+  else if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      const GFC_REAL_16 *restrict bbase_y;
+      GFC_REAL_16 s;
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = &bbase[y*bystride];
+         s = (GFC_REAL_16) 0;
+         for (n = 0; n < count; n++)
+           s += abase[n*axstride] * bbase_y[n*bxstride];
+         dest[y*rxstride] = s;
+       }
+    }
   else
     {
       const GFC_REAL_16 *restrict abase_x;

diff --git a/libgfortran/generated/matmul_r4.c b/libgfortran/generated/matmul_r4.c
index 0855133..d684dd2 100644 (file)
--- a/libgfortran/generated/matmul_r4.c
+++ b/libgfortran/generated/matmul_r4.c
@@ -258,6 +258,20 @@ matmul_r4 (gfc_array_r4 * const restrict retarray,
            /* dest[x,y] += a[x,n] * b[n,y] */
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
+  else if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      const GFC_REAL_4 *restrict bbase_y;
+      GFC_REAL_4 s;
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = &bbase[y*bystride];
+         s = (GFC_REAL_4) 0;
+         for (n = 0; n < count; n++)
+           s += abase[n*axstride] * bbase_y[n*bxstride];
+         dest[y*rxstride] = s;
+       }
+    }
   else
     {
       const GFC_REAL_4 *restrict abase_x;

diff --git a/libgfortran/generated/matmul_r8.c b/libgfortran/generated/matmul_r8.c
index ba177a8..41726bc 100644 (file)
--- a/libgfortran/generated/matmul_r8.c
+++ b/libgfortran/generated/matmul_r8.c
@@ -258,6 +258,20 @@ matmul_r8 (gfc_array_r8 * const restrict retarray,
            /* dest[x,y] += a[x,n] * b[n,y] */
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
+  else if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      const GFC_REAL_8 *restrict bbase_y;
+      GFC_REAL_8 s;
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = &bbase[y*bystride];
+         s = (GFC_REAL_8) 0;
+         for (n = 0; n < count; n++)
+           s += abase[n*axstride] * bbase_y[n*bxstride];
+         dest[y*rxstride] = s;
+       }
+    }
   else
     {
       const GFC_REAL_8 *restrict abase_x;

diff --git a/libgfortran/m4/matmul.m4 b/libgfortran/m4/matmul.m4
index f55e2cf..3678c63 100644 (file)
--- a/libgfortran/m4/matmul.m4
+++ b/libgfortran/m4/matmul.m4
@@ -260,6 +260,20 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl
            /* dest[x,y] += a[x,n] * b[n,y] */
            dest[x*rxstride + y*rystride] += abase[x*axstride + n*aystride] * bbase[n*bxstride + y*bystride];
     }
+  else if (GFC_DESCRIPTOR_RANK (a) == 1)
+    {
+      const rtype_name *restrict bbase_y;
+      rtype_name s;
+
+      for (y = 0; y < ycount; y++)
+       {
+         bbase_y = &bbase[y*bystride];
+         s = (rtype_name) 0;
+         for (n = 0; n < count; n++)
+           s += abase[n*axstride] * bbase_y[n*bxstride];
+         dest[y*rxstride] = s;
+       }
+    }
   else
     {
       const rtype_name *restrict abase_x;