1! { dg-do run }
2!
3! Test the fix for PR86760 in which temporaries were not being
4! assigned for array component references.
5!
6! Contributed by Chris Hansen  <hansec@uw.edu>
7!
8MODULE test_nesting_mod
9  IMPLICIT NONE
10  TYPE :: test_obj1
11  CONTAINS
12    PROCEDURE :: destroy
13  END TYPE
14
15  TYPE :: obj_ptr
16    CLASS(test_obj1), POINTER :: f => NULL()
17  END TYPE
18
19  TYPE :: obj_container
20    TYPE(obj_ptr), POINTER, DIMENSION(:) :: v => NULL()
21  END TYPE
22
23  integer :: ctr = 0
24
25CONTAINS
26
27  SUBROUTINE destroy(self)
28    CLASS(test_obj1), INTENT(INOUT):: self
29    ctr = ctr + 1
30  END SUBROUTINE
31
32  SUBROUTINE container_destroy(self)
33    type(obj_container), INTENT(INOUT) :: self
34    INTEGER :: i
35    DO i=1,ubound(self%v,1)
36      CALL self%v(i)%f%destroy()
37    END DO
38  END SUBROUTINE
39
40END MODULE
41
42
43PROGRAM test_nesting_ptr
44  USE test_nesting_mod
45  IMPLICIT NONE
46  INTEGER :: i
47  INTEGER, PARAMETER :: n = 2
48  TYPE(obj_container) :: var
49
50  ALLOCATE(var%v(n))
51  DO i=1,n
52    ALLOCATE(test_obj1::var%v(i)%f)
53  END DO
54  CALL container_destroy(var)
55
56  if (ctr .ne. 2) stop 1
57END
58