gcc/testsuite/gfortran.dg/allocate_with_mold_1.f90

   1 ! { dg-do run }
   2 !
   3 ! Fixes a bug that emerged from the fix of PR62044 - see the PR. When
   4 ! there was no default initializer, code-expr3 was set null and so the
   5 ! vpointer was set to the vtable of the declared type, rather than that
   6 ! of the MOLD expression.
   7 !
   8 ! Contributed by but based on the original PR62044 testcase by
   9 ! Paul Thomas  <pault@gcc.gnu.org>
  10 !
  11 module GridImageSilo_Template
  12   implicit none
  13   type, public, abstract :: GridImageSiloTemplate
  14   end type GridImageSiloTemplate
  15 end module GridImageSilo_Template
  16
  17 module UnstructuredGridImageSilo_Form
  18   use GridImageSilo_Template
  19   implicit none
  20   type, public, extends ( GridImageSiloTemplate ) :: &
  21     UnstructuredGridImageSiloForm
  22   end type UnstructuredGridImageSiloForm
  23 end module UnstructuredGridImageSilo_Form
  24
  25 module UnstructuredGridImages
  26   use UnstructuredGridImageSilo_Form, &
  27         UnstructuredGridImageForm => UnstructuredGridImageSiloForm
  28 contains
  29   subroutine foo
  30     class (GridImageSiloTemplate), allocatable :: a
  31     type (UnstructuredGridImageForm) :: b
  32     integer :: i = 0
  33     allocate (a, mold = b)
  34     select type (a)
  35       type is (UnstructuredGridImageForm)
  36         i = 1
  37       class default
  38         i = 2
  39     end select
  40     if (i .ne. 1) call abort
  41   end subroutine
  42 end module UnstructuredGridImages
  43
  44   use UnstructuredGridImages
  45   call foo
  46 end
  47