1! { dg-do  run }
2! { dg-options "-O3 -finline-matmul-limit=10 -fdump-tree-optimized -fdump-tree-original" }
3! PR 37131 - all calls to matmul should be optimized away with -O3
4! and the high limit.
5program main
6  real, dimension(3,2) :: a
7  real, dimension(2,4) :: b
8  real, dimension(3,4) :: c
9  real, dimension(3,4) :: cres
10  real, dimension(:,:), allocatable :: calloc
11  integer :: a1 = size(a,1), a2 = size(a,2)
12  integer :: b1 = size(b,1), b2 = size(b,2)
13  integer :: c1 = size(c,1), c2 = size(c,2)
14
15  data a / 2.,  -3.,  5.,  -7., 11., -13./
16  data b /17., -23., 29., -31., 37., -39., 41., -47./
17  data cres /195., -304.,  384.,  275., -428.,  548.,  347., -540.,  692.,  411., -640.,  816./
18  c = matmul(a,b)
19  if (sum(c-cres)>1e-4) STOP 1
20
21  calloc = matmul(a,b)
22  if (sum(calloc-cres)>1e-4) STOP 2
23  if (any([size(calloc,1), size(calloc,2)] /= [3,4])) STOP 3
24  deallocate(calloc)
25
26  allocate(calloc(4,4))
27  calloc = matmul(a,b)
28  if (sum(calloc-cres)>1e-4) STOP 4
29  if (any([size(calloc,1), size(calloc,2)] /= [3,4])) STOP 5
30  deallocate(calloc)
31
32  allocate(calloc(3,3))
33  calloc = matmul(a,b)
34  if (sum(calloc-cres)>1e-4) STOP 6
35  if (any([size(calloc,1), size(calloc,2)] /= [3,4])) STOP 7
36  deallocate(calloc)
37
38  block
39    real :: aa(a1, a2), bb(b1, b2), cc(c1, c2)
40    aa = a
41    bb = b
42
43    cc = matmul(aa,bb)
44    if (sum(cc-cres)>1e-4) STOP 8
45    calloc = matmul(aa,bb)
46    if (sum(calloc-cres)>1e-4) STOP 9
47    if (any([size(calloc,1), size(calloc,2)] /= [3,4])) STOP 10
48    calloc = 42.
49    deallocate(calloc)
50
51    allocate(calloc(4,4))
52    calloc = matmul(aa,bb)
53    if (sum(calloc-cres)>1e-4) STOP 11
54    if (any([size(calloc,1), size(calloc,2)] /= [3,4])) STOP 12
55    deallocate(calloc)
56
57    allocate(calloc(3,3))
58    calloc = matmul(aa,bb)
59    if (sum(calloc-cres)>1e-4) STOP 13
60    if (any([size(calloc,1), size(calloc,2)] /= [3,4])) STOP 14
61    deallocate(calloc)
62  end block
63
64end program main
65! { dg-final { scan-tree-dump-times "_gfortran_matmul" 4 "original" } }
66! { dg-final { scan-tree-dump-times "_gfortran_matmul" 0 "optimized" } }
67