1! { dg-do run }
2!
3! PR fortran/60392
4! In the transposed case call to my_mul_cont, the compiler used to (wrongly)
5! reuse a transposed descriptor for an array that was not transposed as a result
6! of packing.
7!
8! Original test case from Alexander Vogt <a.vogt@fulguritus.com>.
9
10program test
11  implicit none
12
13  integer, dimension(2,2) :: A, R, RT
14  integer, dimension(2,2) :: B1, B2
15
16  !
17  ! A = [  2   17 ]
18  !     [ 82  257 ]
19  !
20  ! matmul(a,a) = [  1398   4403 ]
21  !               [ 21238  67443 ]
22  !
23  ! matmul(transpose(a), a) = [  6728  21108 ]
24  !                           [ 21108  66338 ]
25  A(1,1) =   2
26  A(1,2) =  17
27  A(2,1) =  82
28  A(2,2) = 257
29
30  R(1,1) =  1398
31  R(1,2) =  4403
32  R(2,1) = 21238
33  R(2,2) = 67443
34
35  RT(1,1) =  6728
36  RT(1,2) = 21108
37  RT(2,1) = 21108
38  RT(2,2) = 66338
39
40  ! Normal argument
41  B1 = 0
42  B2 = 0
43  B1 = my_mul(A,A)
44  B2 = my_mul_cont(A,A)
45! print *,'Normal:    ',maxval(abs(B1-B2))
46! print *,B1
47! print *,B2
48  if (any(B1 /= R)) call abort
49  if (any(B2 /= R)) call abort
50
51  ! Transposed argument
52  B1 = 0
53  B2 = 0
54  B1 = my_mul(transpose(A),A)
55  B2 = my_mul_cont(transpose(A),A)
56! print *,'Transposed:',maxval(abs(B1-B2))
57! print *,B1
58! print *,B2
59  if (any(B1 /= RT)) call abort
60  if (any(B2 /= RT)) call abort
61
62contains
63
64  function my_mul(A,C) result (B)
65    use, intrinsic :: ISO_Fortran_env
66    integer, intent(in) :: A(2,2), C(2,2)
67    integer :: B(2,2)
68    B = matmul(A, C)
69  end function
70
71  function my_mul_cont(A,C) result (B)
72    use, intrinsic :: ISO_Fortran_env
73    integer, intent(in), contiguous :: A(:,:), C(:,:)
74    integer :: B(2,2)
75    B = matmul(A, C)
76  end function
77
78end program
79