1! { dg-do compile }
2!
3! PR fortran/56816
4! The unfinished SELECT TYPE statement below was leading to an ICE because
5! at the time the statement was rejected, the compiler tried to free
6! some symbols that had already been freed with the SELECT TYPE
7! namespace.
8!
9! Original testcase from Dominique Pelletier <dominique.pelletier@polymtl.ca>
10!
11module any_list_module
12    implicit none
13
14    private
15    public :: anylist, anyitem
16
17    type anylist
18    end type
19
20    type anyitem
21        class(*), allocatable :: value
22    end type
23end module any_list_module
24
25
26module my_item_list_module
27
28    use any_list_module
29    implicit none
30
31    type, extends (anyitem) :: myitem
32    end type myitem
33
34contains
35
36    subroutine myprint (this)
37        class (myitem) ::   this
38
39        select type ( v => this % value ! { dg-error "parse error in SELECT TYPE" }
40        end select                      ! { dg-error "Expecting END SUBROUTINE" }
41    end subroutine myprint
42
43end module my_item_list_module
44