1! { dg-do compile }
2! { dg-options "-Warray-temporaries -fdump-tree-original" }
3!
4! PR fortran/45648
5! Non-copying descriptor transpose optimization (for function call args).
6!
7! Contributed by Richard Sandiford <richard@codesourcery.com>
8
9module foo
10  interface
11    subroutine ext1 (a, b)
12      real, intent (in), dimension (:, :) :: a, b
13    end subroutine ext1
14    subroutine ext2 (a, b)
15      real, intent (in), dimension (:, :) :: a
16      real, intent (out), dimension (:, :) :: b
17    end subroutine ext2
18    subroutine ext3 (a, b)
19      real, dimension (:, :) :: a, b
20    end subroutine ext3
21  end interface
22contains
23  ! No temporary needed here.
24  subroutine test1 (n, a, b, c)
25    integer :: n
26    real, dimension (n, n) :: a, b, c
27    a = matmul (transpose (b), c)
28  end subroutine test1
29
30  ! No temporary either, as we know the arguments to matmul are intent(in)
31  subroutine test2 (n, a, b)
32    integer :: n
33    real, dimension (n, n) :: a, b
34    a = matmul (transpose (b), b)
35  end subroutine test2
36
37  ! No temporary needed.
38  subroutine test3 (n, a, b, c)
39    integer :: n
40    real, dimension (n, n) :: a, c
41    real, dimension (n+4, n+4) :: b
42    a = matmul (transpose (b (2:n+1, 3:n+2)), c)
43  end subroutine test3
44
45  ! A temporary is needed for the result of either the transpose or matmul.
46  subroutine test4 (n, a, b)
47    integer :: n
48    real, dimension (n, n) :: a, b
49    a = matmul (transpose (a), b)       ! { dg-warning "Creating array temporary" }
50  end subroutine test4
51
52  ! The temporary is needed here since the second argument to imp1
53  ! has unknown intent.
54  subroutine test5 (n, a)
55    integer :: n
56    real, dimension (n, n) :: a
57    call imp1 (transpose (a), a)        ! { dg-warning "Creating array temporary" }
58  end subroutine test5
59
60  ! No temporaries are needed here; imp1 can't modify either argument.
61  ! We have to pack the arguments, however.
62  subroutine test6 (n, a, b)
63    integer :: n
64    real, dimension (n, n) :: a, b
65    call imp1 (transpose (a), transpose (b))    ! { dg-warning "Creating array temporary" }
66  end subroutine test6
67
68  ! No temporaries are needed here; imp1 can't modify either argument.
69  ! We don't have to pack the arguments.
70  subroutine test6_bis (n, a, b)
71    integer :: n
72    real, dimension (n, n) :: a, b
73    call ext3 (transpose (a), transpose (b))
74  end subroutine test6_bis
75
76  ! No temporary is neede here; the second argument is intent(in).
77  subroutine test7 (n, a)
78    integer :: n
79    real, dimension (n, n) :: a
80    call ext1 (transpose (a), a)
81  end subroutine test7
82
83  ! The temporary is needed here though.
84  subroutine test8 (n, a)
85    integer :: n
86    real, dimension (n, n) :: a
87    call ext2 (transpose (a), a)        ! { dg-warning "Creating array temporary" }
88  end subroutine test8
89
90  ! Silly, but we don't need any temporaries here.
91  subroutine test9 (n, a)
92    integer :: n
93    real, dimension (n, n) :: a
94    call ext1 (transpose (transpose (a)), a)
95  end subroutine test9
96
97  ! The outer transpose needs a temporary; the inner one doesn't.
98  subroutine test10 (n, a)
99    integer :: n
100    real, dimension (n, n) :: a
101    call ext2 (transpose (transpose (a)), a)    ! { dg-warning "Creating array temporary" }
102  end subroutine test10
103end module foo
104
105! { dg-final { scan-tree-dump-times "struct\[^\\n\]*atmp" 4 "original" } }
106! { dg-final { cleanup-tree-dump "original" } }
107