1! {dg-do run }
2!
3! Test the fix for PR65024, in which the structure for the 'info'
4! component of type 'T' was not being converted into TREE_SSA and
5! so caused an ICE in trans-expr.c:gfc_conv_component_ref.
6!
7! Reported by  <matt@gneilson.plus.com>
8!
9MODULE X
10  TYPE T
11    CLASS(*), pointer :: info
12  END TYPE
13END MODULE
14
15PROGRAM P
16  call bug
17CONTAINS
18  SUBROUTINE BUG
19    USE X
20    CLASS(T), pointer :: e
21    integer, target :: i = 42
22    allocate(e)
23    e%info => NULL ()      ! used to ICE
24    if (.not.associated(e%info)) e%info => i      ! used to ICE
25    select type (z => e%info)
26      type is (integer)
27        if (z .ne.i) call abort
28    end select
29  END SUBROUTINE
30
31  SUBROUTINE NEXT
32    USE X
33    CLASS (T), pointer :: e
34  END SUBROUTINE
35END
36