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 c482122901d617fa7b737b7c86cf5997a51ed36d..327a048a180241b213780da1a24c4d5b589abd23 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

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 7151344be7e7ce6c136e373f0e003557c7c249be..edba622c70bc837c2b154f32f06adb3dd8703898 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 7b67ddd86a92a3d98a945b7e094324efbc04a783..df2cd93c15ff8dbaa263f3f000c24d16702a1ea6 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 c17bcaaa42ccdd4fc216d2451f127493cd19f9d3..6425eb8d49d986bb64f7edec7cf7233bc82a540f 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 d85bd277fde347d578e8decdd86e8ad6641f565c..2d47a1349729162628b6f582361f146d9568a61a 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 be4ee6ce6b598a2779d6d912d1f2b50470d2e16a..f22719df505a38e73b45c28e42bd1506d18d1e29 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 c4de78a9282a7d1aa42c42d76013b9b263fb3ca0..73c3fbc108d6aed0600329e565aeb75b31751c57 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 cd506a03943b48d51cd8d91961797a39c6217387..63bca0152cdd212d09d642310748d148a8b3420a 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 7bdfb6f715431fc7bdc11a682ecfe75eb27a9bb5..caaf9e8f97631d4cb3dbe684c40fe40083424dda 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 2bdaaf51c5bb6201739c5db681494dd71e104e13..8fa1d6d9e497ef1722fb27651b216de9d2351e0d 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 f120e7fdc56673a772c27b621062cded1933ec4b..0f61b03816815316ff79c7a3508b7fce9865f688 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 085513346e08a6076ff264d45000a4af9b0201c6..d684dd2905c322463424104fe5c083fad3ebb1cf 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 ba177a8e473ed32953d283fa61d99727ae7985bb..41726bce2a5840adca0acf2a3c76dddb0ae7a0ba 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 f55e2cfaa64c9a1360f49ff78a6f13c82d6ad04b..3678c639f2a3c14ec8c42df57e0437c8ab352a12 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;