1! { dg-do run } 2! 3! executing simple SELECT TYPE statements 4! 5! Contributed by Janus Weil <janus@gcc.gnu.org> 6 7 type :: t1 8 integer :: i 9 end type t1 10 11 type, extends(t1) :: t2 12 integer :: j 13 end type t2 14 15 type, extends(t1) :: t3 16 real :: r 17 end type 18 19 class(t1), pointer :: cp 20 type(t1), target :: a 21 type(t2), target :: b 22 type(t3), target :: c 23 integer :: i 24 25 cp => a 26 i = 0 27 28 select type (cp) 29 type is (t1) 30 i = 1 31 type is (t2) 32 i = 2 33 class is (t1) 34 i = 3 35 end select 36 37 if (i /= 1) call abort() 38 39 cp => b 40 i = 0 41 42 select type (cp) 43 type is (t1) 44 i = 1 45 type is (t2) 46 i = 2 47 class is (t2) 48 i = 3 49 end select 50 51 if (i /= 2) call abort() 52 53 cp => c 54 i = 0 55 56 select type (cp) 57 type is (t1) 58 i = 1 59 type is (t2) 60 i = 2 61 class default 62 i = 3 63 end select 64 65 if (i /= 3) call abort() 66 67end 68