OSDN Git Service

2010-02-20 Paul Thomas <pault@gcc.gnu.org>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / internal_pack_8.f90
1 ! { dg-do run }
2 !
3 ! Test the fix for PR43111, in which necessary calls to
4 ! internal PACK/UNPACK were not being generated because
5 ! of an over agressive fix to PR41113/7.
6 !
7 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
8 !
9 SUBROUTINE S2(I)
10  INTEGER :: I(4)
11  !write(6,*) I
12  IF (ANY(I.NE.(/3,5,7,9/))) CALL ABORT()
13 END SUBROUTINE S2
14
15 MODULE M1
16  TYPE T1
17   INTEGER, POINTER, DIMENSION(:) :: data
18  END TYPE T1
19 CONTAINS
20  SUBROUTINE S1()
21    TYPE(T1) :: d
22    INTEGER, TARGET, DIMENSION(10) :: scratch=(/(i,i=1,10)/)
23    INTEGER :: i=2
24    d%data=>scratch(1:9:2)
25 !   write(6,*) d%data(i:)
26    CALL S2(d%data(i:))
27  END SUBROUTINE S1
28 END MODULE M1
29
30 USE M1
31 CALL S1
32 END
33 ! { dg-final { cleanup-modules "M1" } }