gcc/testsuite/gfortran.dg/allocate_with_mold_2.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! Test the fix for PR87284 in which the indexing in allocate with mold
   5 ! was incorrect for class array initialization and resulted in the valgrind
   6 ! error:
   7 ! "Conditional jump or move depends on uninitialised value(s)" at line 42.
   8 !
   9 ! Contributed by Andrew Baldwin on clf.
  10 !
  11       MODULE INTS_TYPE_MODULE
  12         TYPE, ABSTRACT :: BASE_TYPE
  13         END TYPE BASE_TYPE
  14
  15         TYPE, EXTENDS (BASE_TYPE) :: INTS_TYPE
  16           INTEGER, ALLOCATABLE :: INTS(:)
  17         END TYPE INTS_TYPE
  18       CONTAINS
  19         SUBROUTINE MOLD_ALLOCATE (IT_OBJS, MOLD_OBJ)
  20           CLASS (BASE_TYPE), ALLOCATABLE, INTENT (OUT) :: IT_OBJS(:)
  21           CLASS (BASE_TYPE), INTENT (IN) :: MOLD_OBJ
  22
  23           ALLOCATE (IT_OBJS(2), mold = MOLD_OBJ)
  24
  25           RETURN
  26         END SUBROUTINE MOLD_ALLOCATE
  27       END MODULE INTS_TYPE_MODULE
  28
  29       PROGRAM MFE
  30         USE INTS_TYPE_MODULE
  31         IMPLICIT NONE
  32
  33         CLASS (BASE_TYPE), ALLOCATABLE :: IT_OBJS(:)
  34         INTEGER :: I
  35         TYPE (INTS_TYPE) :: MOLD_OBJ
  36
  37         ALLOCATE (INTS_TYPE :: IT_OBJS(2))
  38
  39         SELECT TYPE (IT_OBJS)
  40         TYPE IS (INTS_TYPE)
  41           ALLOCATE (IT_OBJS(1)%INTS(10))
  42
  43           ALLOCATE (IT_OBJS(2)%INTS(10))
  44         END SELECT
  45
  46
  47         DEALLOCATE (IT_OBJS)
  48
  49         CALL MOLD_ALLOCATE (IT_OBJS, MOLD_OBJ)
  50
  51         IF (ALLOCATED(IT_OBJS)) THEN
  52           IF (SIZE(IT_OBJS) .GE. 2) THEN
  53             SELECT TYPE (IT_OBJS)
  54             TYPE IS (INTS_TYPE)
  55               ALLOCATE (IT_OBJS(1)%INTS(10))
  56
  57               ALLOCATE (IT_OBJS(2)%INTS(10))
  58             END SELECT
  59           END IF
  60         END IF
  61       END PROGRAM MFE
  62 ! { dg-final { scan-tree-dump-times "it_objs->_vptr->_size" 1 "original" } }