1! { dg-do run }
2!
3! PR fortran/55763
4!
5! Contributed by Reinhold Bader
6!
7module mod_alloc_scalar_01
8contains
9  subroutine construct(this)
10    class(*), allocatable, intent(out) :: this
11    integer :: this_i
12    this_i = 4
13    allocate(this, source=this_i)
14  end subroutine
15end module
16
17program alloc_scalar_01
18  use mod_alloc_scalar_01
19  implicit none
20  class(*), allocatable :: mystuff
21
22  call construct(mystuff)
23  call construct(mystuff)
24
25  select type(mystuff)
26  type is (integer)
27    if (mystuff == 4) then
28!      write(*,*) 'OK'
29    else
30      call abort()
31!     write(*,*) 'FAIL 1'
32    end if
33  class default
34    call abort()
35!    write(*,*) 'FAIL 2'
36  end select
37end program
38