gcc/testsuite/gfortran.dg/pr86760.f90

   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 !
   8 MODULE 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
  25 CONTAINS
  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
  40 END MODULE
  41
  42
  43 PROGRAM 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
  57 END