1! { dg-do compile }
2! { dg-options "-fcheck=mem" }
3!
4! Test the fix for PR99545, in which the allocate statements caused an ICE.
5!
6! Contributed by Juergen Reuter  <juergen.reuter@desy.de>
7!
8module commands
9  implicit none
10  private
11
12  type, abstract :: range_t
13     integer :: step_mode = 0
14     integer :: n_step = 0
15  end type range_t
16
17  type, extends (range_t) :: range_int_t
18     integer :: i_step = 0
19  end type range_int_t
20
21  type, extends (range_t) :: range_real_t
22     real :: lr_step = 0
23end type range_real_t
24
25  type :: cmd_scan_t
26     private
27     class(range_t), dimension(:), allocatable :: range
28   contains
29     procedure :: compile => cmd_scan_compile
30  end type cmd_scan_t
31
32contains
33
34  subroutine cmd_scan_compile (cmd)
35    class(cmd_scan_t), intent(inout) :: cmd
36    allocate (range_int_t :: cmd%range (3))
37    allocate (range_real_t :: cmd%range (3))
38  end subroutine cmd_scan_compile
39
40end module commands
41