|
131
|
1 ! { dg-do run }
|
|
|
2 !
|
|
|
3 ! Test the fix for PR86328 in which temporaries were not being
|
|
|
4 ! assigned for array component references.
|
|
|
5 !
|
|
|
6 ! Contributed by Martin <mscfd@gmx.net>
|
|
|
7 !
|
|
|
8 program ptr_alloc
|
|
|
9
|
|
|
10 type :: t
|
|
|
11 class(*), allocatable :: val
|
|
|
12 end type
|
|
|
13
|
|
|
14 type :: list
|
|
|
15 type(t), dimension(:), pointer :: ll
|
|
|
16 end type
|
|
|
17
|
|
|
18 integer :: i
|
|
|
19 type(list) :: a
|
|
|
20
|
|
|
21 allocate(a%ll(1:2))
|
|
|
22 do i = 1,2
|
|
|
23 allocate(a%ll(i)%val, source=i)
|
|
|
24 end do
|
|
|
25
|
|
|
26 do i = 1,2
|
|
|
27 call rrr(a, i)
|
|
|
28 end do
|
|
|
29
|
|
|
30 do i = 1,2
|
|
|
31 deallocate(a%ll(i)%val)
|
|
|
32 end do
|
|
|
33 deallocate (a%ll)
|
|
|
34 contains
|
|
|
35
|
|
|
36 subroutine rrr(a, i)
|
|
|
37 type(list), intent(in) :: a
|
|
|
38 class(*), allocatable :: c
|
|
|
39 integer :: i
|
|
|
40
|
|
|
41 allocate(c, source=a%ll(i)%val)
|
|
|
42 select type (c)
|
|
|
43 type is (integer)
|
|
|
44 if (c .ne. i) stop 1
|
|
|
45 end select
|
|
|
46
|
|
|
47 end subroutine
|
|
|
48
|
|
|
49 end
|
