|
111
|
1 ! { dg-do run }
|
|
|
2 ! { dg-options "-ffrontend-optimize -fdump-tree-original -Wrealloc-lhs" }
|
|
|
3 ! PR 66094: Check functionality for MATMUL(A, TRANSPSE(B))
|
|
|
4 module x
|
|
|
5 contains
|
|
|
6 subroutine mm1(a,b,c)
|
|
|
7 real, dimension(:,:), intent(in) :: a, b
|
|
|
8 real, dimension(:,:), intent(out) :: c
|
|
|
9 c = -42.
|
|
|
10 c = matmul(a, transpose(b))
|
|
|
11 end subroutine mm1
|
|
|
12 end module x
|
|
|
13
|
|
|
14 program main
|
|
|
15 use x
|
|
|
16 implicit none
|
|
|
17 integer, parameter :: n = 3, m=4, cnt=2
|
|
|
18 real, dimension(n,cnt) :: a
|
|
|
19 real, dimension(m,cnt) :: b
|
|
|
20 real, dimension(n,m) :: c, cres
|
|
|
21 real, dimension(:,:), allocatable :: calloc
|
|
|
22
|
|
|
23 data a / 2., -3., 5., -7., 11., -13./
|
|
|
24 data b /17., -23., 29., -31., 37., -39., 41., -47./
|
|
|
25 data cres / -225., 356., -396., 227., -360., 392., &
|
|
|
26 -229., 364., -388., 267., -424., 456./
|
|
|
27
|
|
|
28 c = matmul(a,transpose(b))
|
|
131
|
29 if (sum(c-cres)>1e-4) STOP 1
|
|
111
|
30 call mm1 (a, b, c)
|
|
131
|
31 if (sum(c-cres)>1e-4) STOP 2
|
|
111
|
32
|
|
|
33 ! Unallocated
|
|
|
34 calloc = matmul(a,transpose(b)) ! { dg-warning "Code for reallocating the allocatable array" }
|
|
131
|
35 if (any(shape(c) /= shape(calloc))) STOP 3
|
|
|
36 if (sum(calloc-cres)>1e-4) STOP 4
|
|
111
|
37 deallocate(calloc)
|
|
|
38
|
|
|
39 ! Allocated to wrong shape
|
|
|
40 allocate (calloc(10,10))
|
|
|
41 calloc = matmul(a,transpose(b)) ! { dg-warning "Code for reallocating the allocatable array" }
|
|
131
|
42 if (any(shape(c) /= shape(calloc))) STOP 5
|
|
|
43 if (sum(calloc-cres)>1e-4) STOP 6
|
|
111
|
44 deallocate(calloc)
|
|
|
45
|
|
|
46 end program main
|
|
131
|
47 ! { dg-final { scan-tree-dump-times "_gfortran_matmul" 1 "original" } }
|
