1! { dg-do run }
2! { dg-options "-fdump-tree-original" }
3!
4! Test the fix for PR41113 and PR41117, in which unnecessary calls
5! to internal_pack and internal_unpack were being generated.
6!
7! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
8!
9MODULE M1
10 TYPE T1
11   REAL :: data(10) = [(i, i = 1, 10)]
12 END TYPE T1
13CONTAINS
14 SUBROUTINE S1(data, i, chksum)
15   REAL, DIMENSION(*) :: data
16   integer :: i, j
17   real :: subsum, chksum
18   subsum = 0
19   do j = 1, i
20     subsum = subsum + data(j)
21   end do
22   if (abs(subsum - chksum) > 1e-6) STOP 1
23 END SUBROUTINE S1
24END MODULE
25
26SUBROUTINE S2
27 use m1
28 TYPE(T1) :: d
29
30 real :: data1(10) = [(i, i = 1, 10)]
31 REAL :: data(-4:5,-4:5) = reshape ([(real(i), i = 1, 100)], [10,10])
32
33! PR41113
34 CALL S1(d%data, 10, sum (d%data))
35 CALL S1(data1, 10, sum (data1))
36
37! PR41117
38 DO i=-4,5
39    CALL S1(data(:,i), 10, sum (data(:,i)))
40 ENDDO
41
42! With the fix for PR41113/7 this is the only time that _internal_pack
43! was called.  The final part of the fix for PR43072 put paid to it too.
44 DO i=-4,5
45    CALL S1(data(-2:,i), 8, sum (data(-2:,i)))
46 ENDDO
47 DO i=-4,4
48    CALL S1(data(:,i:i+1), 20, sum (reshape (data(:,i:i+1), [20])))
49 ENDDO
50 DO i=-4,5
51    CALL S1(data(2,i), 1, data(2,i))
52 ENDDO
53END SUBROUTINE S2
54
55 call s2
56end
57! { dg-final { scan-tree-dump-times "_gfortran_internal_pack" 0 "original" } }
58