gcc/testsuite/gfortran.dg/allocate_with_mold_2.f90

! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! Test the fix for PR87284 in which the indexing in allocate with mold
! was incorrect for class array initialization and resulted in the valgrind
! error:
! "Conditional jump or move depends on uninitialised value(s)" at line 42.
!
! Contributed by Andrew Baldwin on clf.
!
      MODULE INTS_TYPE_MODULE
        TYPE, ABSTRACT :: BASE_TYPE
        END TYPE BASE_TYPE

        TYPE, EXTENDS (BASE_TYPE) :: INTS_TYPE
          INTEGER, ALLOCATABLE :: INTS(:)
        END TYPE INTS_TYPE
      CONTAINS
        SUBROUTINE MOLD_ALLOCATE (IT_OBJS, MOLD_OBJ)
          CLASS (BASE_TYPE), ALLOCATABLE, INTENT (OUT) :: IT_OBJS(:)
          CLASS (BASE_TYPE), INTENT (IN) :: MOLD_OBJ

          ALLOCATE (IT_OBJS(2), mold = MOLD_OBJ)

          RETURN
        END SUBROUTINE MOLD_ALLOCATE
      END MODULE INTS_TYPE_MODULE

      PROGRAM MFE
        USE INTS_TYPE_MODULE
        IMPLICIT NONE

        CLASS (BASE_TYPE), ALLOCATABLE :: IT_OBJS(:)
        INTEGER :: I
        TYPE (INTS_TYPE) :: MOLD_OBJ

        ALLOCATE (INTS_TYPE :: IT_OBJS(2))

        SELECT TYPE (IT_OBJS)
        TYPE IS (INTS_TYPE)
          ALLOCATE (IT_OBJS(1)%INTS(10))

          ALLOCATE (IT_OBJS(2)%INTS(10))
        END SELECT


        DEALLOCATE (IT_OBJS)

        CALL MOLD_ALLOCATE (IT_OBJS, MOLD_OBJ)

        IF (ALLOCATED(IT_OBJS)) THEN
          IF (SIZE(IT_OBJS) .GE. 2) THEN
            SELECT TYPE (IT_OBJS)
            TYPE IS (INTS_TYPE)
              ALLOCATE (IT_OBJS(1)%INTS(10))

              ALLOCATE (IT_OBJS(2)%INTS(10))
            END SELECT
          END IF
        END IF
      END PROGRAM MFE
! { dg-final { scan-tree-dump-times "it_objs->_vptr->_size" 1 "original" } }