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!
11module GridImageSilo_Template
12  implicit none
13  type, public, abstract :: GridImageSiloTemplate
14  end type GridImageSiloTemplate
15end module GridImageSilo_Template
16
17module UnstructuredGridImageSilo_Form
18  use GridImageSilo_Template
19  implicit none
20  type, public, extends ( GridImageSiloTemplate ) :: &
21    UnstructuredGridImageSiloForm
22  end type UnstructuredGridImageSiloForm
23end module UnstructuredGridImageSilo_Form
24
25module UnstructuredGridImages
26  use UnstructuredGridImageSilo_Form, &
27        UnstructuredGridImageForm => UnstructuredGridImageSiloForm
28contains
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
42end module UnstructuredGridImages
43
44  use UnstructuredGridImages
45  call foo
46end
47
48