From 54a838424ea995d251eb361f86794e5215fbe574 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Tue, 25 Dec 2007 10:12:41 +0000 Subject: [PATCH] re PR fortran/34566 (Matmul of logical values) 2007-12-25 Thomas Koenig PR libfortran/34566 * m4/matmull.m4: Multiply xstride and ystride by correct kind. * generated/matmul_l4.c: Regenerated. * generated/matmul_l8.c: Regenerated. * generated/matmul_l16.c: Regenerated. 2007-12-25 Thomas Koenig PR libfortran/34566 * gfortran.dg/matmul_6.f90: New test. From-SVN: r131167 --- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/matmul_6.f90 | 66 ++++++++++++++++++++++++++ libgfortran/ChangeLog | 8 ++++ libgfortran/generated/matmul_l16.c | 4 +- libgfortran/generated/matmul_l4.c | 4 +- libgfortran/generated/matmul_l8.c | 4 +- libgfortran/m4/matmull.m4 | 4 +- 7 files changed, 87 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/matmul_6.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9f5aa260888..4bfd5232c20 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-12-25 Thomas Koenig + + PR libfortran/34566 + * gfortran.dg/matmul_6.f90: New test. + 2007-12-23 Tobias Burnus PR fortran/34421 diff --git a/gcc/testsuite/gfortran.dg/matmul_6.f90 b/gcc/testsuite/gfortran.dg/matmul_6.f90 new file mode 100644 index 00000000000..737c5c43759 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/matmul_6.f90 @@ -0,0 +1,66 @@ +! { dg-do run } +! PR 34566 - logical matmul used to give the wrong result. +! We check this by running through every permutation in +! multiplying two 3*3 matrices, and all permutations of multiplying +! a 3-vector and a 3*3 matrices and checking against equivalence +! with integer matrix multiply. +program main + implicit none + integer, parameter :: ki=4 + integer, parameter :: dimen=3 + integer :: i, j, k + real, dimension(dimen,dimen) :: r1, r2 + integer, dimension(dimen,dimen) :: m1, m2 + logical(kind=ki), dimension(dimen,dimen) :: l1, l2 + logical(kind=ki), dimension(dimen*dimen) :: laux + logical(kind=ki), dimension(dimen) :: lv + integer, dimension(dimen) :: iv + + do i=0,2**(dimen*dimen)-1 + forall (k=1:dimen*dimen) + laux(k) = btest(i, k-1) + end forall + l1 = reshape(laux,shape(l1)) + m1 = ltoi(l1) + + ! Check matrix*matrix multiply + do j=0,2**(dimen*dimen)-1 + forall (k=1:dimen*dimen) + laux(k) = btest(i, k-1) + end forall + l2 = reshape(laux,shape(l2)) + m2 = ltoi(l2) + if (any(matmul(l1,l2) .neqv. (matmul(m1,m2) /= 0))) then + call abort + end if + end do + + ! Check vector*matrix and matrix*vector multiply. + do j=0,2**dimen-1 + forall (k=1:dimen) + lv(k) = btest(j, k-1) + end forall + iv = ltoi(lv) + if (any(matmul(lv,l1) .neqv. (matmul(iv,m1) /=0))) then + call abort + end if + if (any(matmul(l1,lv) .neqv. (matmul(m1,iv) /= 0))) then + call abort + end if + end do + end do + +contains + elemental function ltoi(v) + implicit none + integer :: ltoi + real :: rtoi + logical(kind=4), intent(in) :: v + if (v) then + ltoi = 1 + else + ltoi = 0 + end if + end function ltoi + +end program main diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 9d84e1bd5fa..8f32ca04d7c 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,11 @@ +2007-12-25 Thomas Koenig + + PR libfortran/34566 + * m4/matmull.m4: Multiply xstride and ystride by correct kind. + * generated/matmul_l4.c: Regenerated. + * generated/matmul_l8.c: Regenerated. + * generated/matmul_l16.c: Regenerated. + 2007-12-19 Tobias Burnus PR fortran/34530 diff --git a/libgfortran/generated/matmul_l16.c b/libgfortran/generated/matmul_l16.c index c3cabdb090f..b2b86ecfed1 100644 --- a/libgfortran/generated/matmul_l16.c +++ b/libgfortran/generated/matmul_l16.c @@ -152,7 +152,7 @@ matmul_l16 (gfc_array_l16 * const restrict retarray, { astride = a->dim[1].stride * a_kind; count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xstride = a->dim[0].stride; + xstride = a->dim[0].stride * a_kind; xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -167,7 +167,7 @@ matmul_l16 (gfc_array_l16 * const restrict retarray, { bstride = b->dim[0].stride * b_kind; assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); - ystride = b->dim[1].stride; + ystride = b->dim[1].stride * b_kind; ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; } diff --git a/libgfortran/generated/matmul_l4.c b/libgfortran/generated/matmul_l4.c index 531603ba34b..9a6cb1d357d 100644 --- a/libgfortran/generated/matmul_l4.c +++ b/libgfortran/generated/matmul_l4.c @@ -152,7 +152,7 @@ matmul_l4 (gfc_array_l4 * const restrict retarray, { astride = a->dim[1].stride * a_kind; count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xstride = a->dim[0].stride; + xstride = a->dim[0].stride * a_kind; xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -167,7 +167,7 @@ matmul_l4 (gfc_array_l4 * const restrict retarray, { bstride = b->dim[0].stride * b_kind; assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); - ystride = b->dim[1].stride; + ystride = b->dim[1].stride * b_kind; ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; } diff --git a/libgfortran/generated/matmul_l8.c b/libgfortran/generated/matmul_l8.c index 0b9b0be6b51..7d4e35e82e3 100644 --- a/libgfortran/generated/matmul_l8.c +++ b/libgfortran/generated/matmul_l8.c @@ -152,7 +152,7 @@ matmul_l8 (gfc_array_l8 * const restrict retarray, { astride = a->dim[1].stride * a_kind; count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xstride = a->dim[0].stride; + xstride = a->dim[0].stride * a_kind; xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -167,7 +167,7 @@ matmul_l8 (gfc_array_l8 * const restrict retarray, { bstride = b->dim[0].stride * b_kind; assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); - ystride = b->dim[1].stride; + ystride = b->dim[1].stride * b_kind; ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; } diff --git a/libgfortran/m4/matmull.m4 b/libgfortran/m4/matmull.m4 index b488632137f..54afa8a238e 100644 --- a/libgfortran/m4/matmull.m4 +++ b/libgfortran/m4/matmull.m4 @@ -154,7 +154,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl { astride = a->dim[1].stride * a_kind; count = a->dim[1].ubound + 1 - a->dim[1].lbound; - xstride = a->dim[0].stride; + xstride = a->dim[0].stride * a_kind; xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; } if (GFC_DESCRIPTOR_RANK (b) == 1) @@ -169,7 +169,7 @@ sinclude(`matmul_asm_'rtype_code`.m4')dnl { bstride = b->dim[0].stride * b_kind; assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); - ystride = b->dim[1].stride; + ystride = b->dim[1].stride * b_kind; ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; }