OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [matmul_6.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! PR 34566 - logical matmul used to give the wrong result.
3
! We check this by running through every permutation in
4
! multiplying two 3*3 matrices, and all permutations of multiplying
5
! a 3-vector and a 3*3 matrices  and checking against equivalence
6
! with integer matrix multiply.
7
program main
8
  implicit none
9
  integer, parameter :: ki=4
10
  integer, parameter :: dimen=3
11
  integer :: i, j, k
12
  real, dimension(dimen,dimen) :: r1, r2
13
  integer, dimension(dimen,dimen) :: m1, m2
14
  logical(kind=ki), dimension(dimen,dimen) :: l1, l2
15
  logical(kind=ki), dimension(dimen*dimen) :: laux
16
  logical(kind=ki), dimension(dimen) :: lv
17
  integer, dimension(dimen) :: iv
18
 
19
  do i=0,2**(dimen*dimen)-1
20
     forall (k=1:dimen*dimen)
21
        laux(k) = btest(i, k-1)
22
     end forall
23
     l1 = reshape(laux,shape(l1))
24
     m1 = ltoi(l1)
25
 
26
     ! Check matrix*matrix multiply
27
     do j=0,2**(dimen*dimen)-1
28
        forall (k=1:dimen*dimen)
29
           laux(k) = btest(i, k-1)
30
        end forall
31
        l2 = reshape(laux,shape(l2))
32
        m2 = ltoi(l2)
33
        if (any(matmul(l1,l2) .neqv. (matmul(m1,m2) /= 0))) then
34
          call abort
35
        end if
36
     end do
37
 
38
     ! Check vector*matrix and matrix*vector multiply.
39
     do j=0,2**dimen-1
40
        forall (k=1:dimen)
41
           lv(k) = btest(j, k-1)
42
        end forall
43
        iv = ltoi(lv)
44
        if (any(matmul(lv,l1) .neqv. (matmul(iv,m1) /=0))) then
45
          call abort
46
        end if
47
        if (any(matmul(l1,lv) .neqv. (matmul(m1,iv) /= 0))) then
48
          call abort
49
        end if
50
     end do
51
  end do
52
 
53
contains
54
  elemental function ltoi(v)
55
    implicit none
56
    integer :: ltoi
57
    real :: rtoi
58
    logical(kind=4), intent(in) :: v
59
    if (v) then
60
       ltoi = 1
61
    else
62
       ltoi = 0
63
    end if
64
  end function ltoi
65
 
66
end program main

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.