1! { dg-do run }
2! { dg-options "-Warray-temporaries" }
3! PR 57023
4! This used to cause wrong packing because a(1:n,1:n) was
5! assumed to be a full array.
6module mymod
7  implicit none
8contains
9  subroutine foo1(a,n)
10    integer, dimension(n,n), intent(inout) :: a
11    integer :: n
12    n = n - 1
13    call baz(a(1:n,1:n),n)  ! { dg-warning "array temporary" }
14  end subroutine foo1
15
16  subroutine foo2(a,n)
17    integer, dimension(n,n), intent(inout) :: a
18    integer :: n
19    call decrement(n)
20    call baz(a(1:n,1:n),n)  ! { dg-warning "array temporary" }
21  end subroutine foo2
22
23  subroutine foo3(a,n)
24    integer, dimension(n,n), intent(inout) :: a
25    integer :: n, m
26    m = n - 1
27    call baz(a(1:m,1:m),m)  ! { dg-warning "array temporary" }
28  end subroutine foo3
29
30  subroutine foo4(a,n)
31    integer, dimension(n,n), intent(inout) :: a
32    integer, intent(in) :: n
33    a(1:n,1:n) = 1
34  end subroutine foo4
35
36  subroutine baz(a,n)
37    integer, dimension(n,n), intent(inout) :: a
38    integer, intent(in) :: n
39    a = 1
40  end subroutine baz
41
42  subroutine decrement(n)
43    integer, intent(inout) :: n
44    n = n - 1
45  end subroutine decrement
46
47end module mymod
48
49program main
50  use mymod
51  implicit none
52  integer, dimension(5,5) :: a, b
53  integer :: n
54
55  b = 0
56  b(1:4,1:4) = 1
57
58  n = 5
59  a = 0
60  call foo1(a,n)
61  if (any(a /= b)) call abort
62
63  n = 5
64  a = 0
65  call foo2(a,n)
66  if (any(a /= b)) call abort
67
68  n = 5
69  a = 0
70  call foo3(a,n)
71  if (any(a /= b)) call abort
72
73  n = 5
74  a = 0
75  call foo4(a,n)
76  if (any(a /= 1)) call abort
77end program main
78