1! { dg-do compile }
2! { dg-options "-fdump-tree-original" }
3!
4! Test the fix for PR43072, in which unnecessary calls to
5! internal PACK/UNPACK were being generated.
6!
7! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
8!
9MODULE M1
10  PRIVATE
11  REAL, PARAMETER :: c(2)=(/(i,i=1,2)/)
12CONTAINS
13  ! WAS OK
14  SUBROUTINE S0
15    real :: r
16     r=0
17     r=S2(c)
18     r=S2((/(real(i),i=1,2)/)) ! See comment #1 of the PR
19  END SUBROUTINE S0
20  ! WAS NOT OK
21  SUBROUTINE S1
22    real :: r
23     r=0
24     r=r+S2(c)
25     r=r+S2((/(real(i),i=1,2)/)) ! See comment #1 of the PR
26  END SUBROUTINE S1
27
28  FUNCTION S2(c)
29     REAL, INTENT(IN) :: c(2)
30     s2=0
31  END FUNCTION S2
32END MODULE M1
33! { dg-final { scan-tree-dump-times "pack" 0 "original" } }
34! { dg-final { cleanup-tree-dump "original" } }
35