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.
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
31 type(foo
), dimension(3,2) :: afoo
32 type(foo
), dimension(2,4) :: bfoo
33 type(foo
), dimension(3,4) :: cfoo
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./
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./
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)
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
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
64 if (sum(abs(c
-cres
))>1e-4) STOP 1
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
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
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
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
92 if (sum(abs(cp
-cres
)) > 1e-4) STOP 10
97 c
= matmul(f(1,1:3,2:3), f(2,2:3,:))
98 if (sum(abs(c
-cres
))>1e-4) STOP 11
100 f(3,1:eight
:2,:) = matmul(a
, b
)
101 if (sum(abs(f(3,1:eight
:2,:)-cres
))>1e-4) STOP 12
105 cfoo
%a
= matmul(afoo
%a
, bfoo
%a
)
107 if (sum(abs(cfoo
%a
-cres
)) > 1e-4) STOP 13
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
)
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
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
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
141 if (sum(abs(cm
-cres
)) > 1e-4) STOP 21
145 cm(:,:) = matmul(a
,bm
)
146 if (sum(abs(cm
-cres
)) > 1e-4) STOP 22
152 ! { dg-final { scan-tree-dump-times "_gfortran_matmul" 0 "optimized" } }