1! { dg-do run }
2! { dg-options "-ffrontend-optimize -fdump-tree-original" }
3!
4! PR fortran/87597
5!
6! Contributed by gallmeister
7!
8! Before, for the inlined matmul,
9! gamma5 was converted to an EXPR_ARRAY with lbound = 1
10! instead of the lbound = 0 as declared; leading to
11! an off-by-one problem.
12!
13program testMATMUL
14  implicit none
15    complex, dimension(0:3,0:3), parameter :: gamma5 = reshape((/ 0., 0., 1., 0., &
16                                                                  0., 0., 0., 1., &
17                                                                  1., 0., 0., 0., &
18                                                                  0., 1., 0., 0. /),(/4,4/))
19    complex, dimension(0:3,0:3) :: A, B, D
20    integer :: i
21
22    A = 0.0
23    do i=0,3
24       A(i,i) = i*1.0
25    end do
26
27    B = cmplx(7,-9)
28    B = matmul(A,gamma5)
29
30    D = reshape([0, 0, 2, 0, &
31                 0, 0, 0, 3, &
32                 0, 0, 0, 0, &
33                 0, 1, 0, 0], [4, 4])
34    write(*,*) B(0,:)
35    write(*,*) B(1,:)
36    write(*,*) B(2,:)
37    write(*,*) B(3,:)
38    if (any(B /= D)) then
39      call abort()
40    end if
41end program testMATMUL
42! { dg-final { scan-tree-dump-times "gamma5\\\[__var_1_do \\* 4 \\+ __var_2_do\\\]|gamma5\\\[NON_LVALUE_EXPR <__var_1_do> \\* 4 \\+ NON_LVALUE_EXPR <__var_2_do>\\\]" 1 "original" } }
43