1! { dg-do compile }
2! { dg-options "-fsecond-underscore" }
3! PR fortran/95088 - ICE in gfc_build_class_symbol, at fortran/class.c:653
4
5module m2345678901234567890123456789012345678901234567890123456789_123
6  type t2345678901234567890123456789012345678901234567890123456789_123 &
7      (n2345678901234567890123456789012345678901234567890123456789_123,&
8       r2345678901234567890123456789012345678901234567890123456789_123,&
9       k2345678901234567890123456789012345678901234567890123456789_123,&
10       l2345678901234567890123456789012345678901234567890123456789_123 )
11     integer, kind :: n2345678901234567890123456789012345678901234567890123456789_123
12     integer, kind :: r2345678901234567890123456789012345678901234567890123456789_123
13     integer, kind :: k2345678901234567890123456789012345678901234567890123456789_123
14     integer, len  :: l2345678901234567890123456789012345678901234567890123456789_123
15     complex (kind  = r2345678901234567890123456789012345678901234567890123456789_123) &
16                   :: z2345678901234567890123456789012345678901234567890123456789_123
17     character(kind = k2345678901234567890123456789012345678901234567890123456789_123, &
18                len = l2345678901234567890123456789012345678901234567890123456789_123) &
19                   :: c2345678901234567890123456789012345678901234567890123456789_123
20  end type
21  type, extends (t2345678901234567890123456789012345678901234567890123456789_123) :: &
22      a2345678901234567890123456789012345678901234567890123456789_123
23  end type
24  interface
25     module subroutine s2345678901234567890123456789012345678901234567890123456789_123 &
26                      (x2345678901234567890123456789012345678901234567890123456789_123)
27       class(a2345678901234567890123456789012345678901234567890123456789_123(16,8,4,1234567890)) :: &
28             x2345678901234567890123456789012345678901234567890123456789_123
29     end
30  end interface
31end
32