summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/matmul_4.f9022
-rw-r--r--libgfortran/ChangeLog18
-rw-r--r--libgfortran/generated/matmul_c10.c14
-rw-r--r--libgfortran/generated/matmul_c16.c14
-rw-r--r--libgfortran/generated/matmul_c4.c14
-rw-r--r--libgfortran/generated/matmul_c8.c14
-rw-r--r--libgfortran/generated/matmul_i16.c14
-rw-r--r--libgfortran/generated/matmul_i4.c14
-rw-r--r--libgfortran/generated/matmul_i8.c14
-rw-r--r--libgfortran/generated/matmul_r10.c14
-rw-r--r--libgfortran/generated/matmul_r16.c14
-rw-r--r--libgfortran/generated/matmul_r4.c14
-rw-r--r--libgfortran/generated/matmul_r8.c14
-rw-r--r--libgfortran/m4/matmul.m414
15 files changed, 213 insertions, 0 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c482122901d..327a048a180 100644
--- 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
index 00000000000..8bbaef934c1
--- /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 7151344be7e..edba622c70b 100644
--- 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 7b67ddd86a9..df2cd93c15f 100644
--- 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 c17bcaaa42c..6425eb8d49d 100644
--- 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 d85bd277fde..2d47a134972 100644
--- 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 be4ee6ce6b5..f22719df505 100644
--- 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 c4de78a9282..73c3fbc108d 100644
--- 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 cd506a03943..63bca0152cd 100644
--- 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 7bdfb6f7154..caaf9e8f976 100644
--- 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 2bdaaf51c5b..8fa1d6d9e49 100644
--- 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 f120e7fdc56..0f61b038168 100644
--- 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 085513346e0..d684dd2905c 100644
--- 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 ba177a8e473..41726bce2a5 100644
--- 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 f55e2cfaa64..3678c639f2a 100644
--- 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;
View Lorry Controller Status