1! { dg-do  run }
2! { dg-options "-ffrontend-optimize -fdump-tree-optimized -Wrealloc-lhs" }
3! PR 37131 - check basic functionality of inlined matmul, making
4! sure that the library is not called, with and without reallocation.
5
6program main
7  implicit none
8  integer, parameter :: offset = -2
9  real, dimension(3,2) :: a
10  real, dimension(2,4) :: b
11  real, dimension(3,4) :: c
12  real, dimension(3,4) :: cres
13  real, dimension(:,:), allocatable :: c_alloc
14  integer, parameter :: a1_lower_p = 1 + offset, a1_upper_p = size(a,1) + offset
15  integer, parameter :: a2_lower_p = 1 + offset, a2_upper_p = size(a,2) + offset
16  integer, parameter :: b1_lower_p = 1 + offset, b1_upper_p = size(b,1) + offset
17  integer, parameter :: b2_lower_p = 1 + offset, b2_upper_p = size(b,2) + offset
18  integer, parameter :: c1_lower_p = 1 + offset, c1_upper_p = size(c,1) + offset
19  integer, parameter :: c2_lower_p = 1 + offset, c2_upper_p = size(c,2) + offset
20  real, dimension(a1_lower_p:a1_upper_p, a2_lower_p:a2_upper_p) :: ap
21  real, dimension(b1_lower_p:b1_upper_p, b2_lower_p:b2_upper_p) :: bp
22  real, dimension(c1_lower_p:c1_upper_p, c2_lower_p:c2_upper_p) :: cp
23  real, dimension(4,8,4) :: f, fresult
24  integer :: eight = 8, two = 2
25
26  type foo
27     real :: a
28     integer :: i
29  end type foo
30
31  type(foo), dimension(3,2) :: afoo
32  type(foo), dimension(2,4) :: bfoo
33  type(foo), dimension(3,4) :: cfoo
34
35  data a / 2.,  -3.,  5.,  -7., 11., -13./
36  data b /17., -23., 29., -31., 37., -39., 41., -47./
37  data cres /195., -304.,  384.,  275., -428.,  548.,  347., -540.,  692.,  411., -640.,  816./
38  data fresult / &
39   0.,   0., 195.,   0.,   0.,  17.,   0.,   0.,   0., -23.,-304.,   0.,   0.,   0.,   0.,   0., &
40   0.,   0., 384.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0., &
41   2.,   0., 275.,   0.,  -3.,  29.,   0.,   0.,   5., -31.,-428.,   0.,   0.,   0.,   0.,   0., &
42   0.,   0., 548.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0., &
43  -7.,   0., 347.,   0.,  11.,  37.,   0.,   0., -13., -39.,-540.,   0.,   0.,   0.,   0.,   0., &
44   0.,   0., 692.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0., &
45   0.,   0., 411.,   0.,   0.,  41.,   0.,   0.,   0., -47.,-640.,   0.,   0.,   0.,   0.,   0., &
46   0.,   0., 816.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0.,   0./
47
48  integer :: a1 = size(a,1), a2 = size(a,2)
49  integer :: b1 = size(b,1), b2 = size(b,2)
50  integer :: c1 = size(c,1), c2 = size(c,2)
51
52  integer :: a1_lower, a1_upper, a2_lower, a2_upper
53  integer :: b1_lower, b1_upper, b2_lower, b2_upper
54  integer :: c1_lower, c1_upper, c2_lower, c2_upper
55
56  a1_lower = 1 + offset ; a1_upper = a1 + offset
57  a2_lower = 1 + offset ; a2_upper = a2 + offset
58  b1_lower = 1 + offset ; b1_upper = b1 + offset
59  b2_lower = 1 + offset ; b2_upper = b2 + offset
60  c1_lower = 1 + offset ; c1_upper = c1 + offset
61  c2_lower = 1 + offset ; c2_upper = c2 + offset
62
63  c = matmul(a,b)
64  if (sum(abs(c-cres))>1e-4) STOP 1
65
66  c_alloc = matmul(a,b)      ! { dg-warning "Code for reallocating the allocatable array" }
67  if (sum(abs(c_alloc-cres))>1e-4) STOP 2
68  if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 3
69  deallocate(c_alloc)
70
71  allocate(c_alloc(4,4))
72  c_alloc = matmul(a,b)      ! { dg-warning "Code for reallocating the allocatable array" }
73  if (sum(abs(c_alloc-cres))>1e-4) STOP 4
74  if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 5
75  deallocate(c_alloc)
76
77  allocate(c_alloc(3,3))
78  c_alloc = matmul(a,b)      ! { dg-warning "Code for reallocating the allocatable array" }
79  if (sum(abs(c_alloc-cres))>1e-4) STOP 6
80  if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 7
81
82  c_alloc = 42.
83  c_alloc(:,:) = matmul(a,b)
84  if (sum(abs(c_alloc-cres))>1e-4) STOP 8
85  if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 9
86
87  deallocate(c_alloc)
88
89  ap = a
90  bp = b
91  cp = matmul(ap, bp)
92  if (sum(abs(cp-cres)) > 1e-4) STOP 10
93
94  f = 0
95  f(1,1:3,2:3) = a
96  f(2,2:3,:) = b
97  c = matmul(f(1,1:3,2:3), f(2,2:3,:))
98  if (sum(abs(c-cres))>1e-4) STOP 11
99
100  f(3,1:eight:2,:) = matmul(a, b)
101  if (sum(abs(f(3,1:eight:2,:)-cres))>1e-4) STOP 12
102
103  afoo%a = a
104  bfoo%a = b
105  cfoo%a = matmul(afoo%a, bfoo%a)
106
107  if (sum(abs(cfoo%a-cres)) > 1e-4) STOP 13
108
109  block
110    real :: aa(a1, a2), bb(b1, b2), cc(c1, c2)
111    real :: am(a1_lower:a1_upper, a2_lower:a2_upper)
112    real :: bm(b1_lower:b1_upper, b2_lower:b2_upper)
113    real :: cm(c1_lower:c1_upper, c2_lower:c2_upper)
114
115    aa = a
116    bb = b
117    am = a
118    bm = b
119
120    cc = matmul(aa,bb)
121    if (sum(cc-cres)>1e-4) STOP 14
122    c_alloc = matmul(aa,bb)    ! { dg-warning "Code for reallocating the allocatable array" }
123    if (sum(abs(c_alloc-cres))>1e-4) STOP 15
124    if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 16
125    c_alloc = 42.
126    deallocate(c_alloc)
127
128    allocate(c_alloc(4,4))
129    c_alloc = matmul(aa,bb)   ! { dg-warning "Code for reallocating the allocatable array" }
130    if (sum(abs(c_alloc-cres))>1e-4) STOP 17
131    if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 18
132    deallocate(c_alloc)
133
134    allocate(c_alloc(3,3))
135    c_alloc = matmul(aa,bb)  ! { dg-warning "Code for reallocating the allocatable array" }
136    if (sum(abs(c_alloc-cres))>1e-4) STOP 19
137    if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 20
138    deallocate(c_alloc)
139
140    cm = matmul(am, bm)
141    if (sum(abs(cm-cres)) > 1e-4) STOP 21
142
143    cm = 42.
144
145    cm(:,:) = matmul(a,bm)
146    if (sum(abs(cm-cres)) > 1e-4) STOP 22
147
148  end block
149
150end program main
151
152! { dg-final { scan-tree-dump-times "_gfortran_matmul" 0 "optimized" } }
153