1! { dg-do run } 2! 3! Tests the fix for PR67933, which was a side effect of the fix for PR67171. 4! 5! Contributed by Andrew <mandrew9@vt.edu> 6! 7module test_mod 8 implicit none 9 10 type :: class_t 11 integer :: i 12 end type class_t 13 14 type, extends(class_t) :: class_e 15 real :: r 16 end type class_e 17 18 type :: wrapper_t 19 class(class_t), allocatable :: class_var 20! type(class_t), allocatable :: class_var 21! integer, allocatable :: class_id 22 end type wrapper_t 23 24 type :: list_t 25 type(wrapper_t) :: classes(20) 26 contains 27 procedure :: Method 28 procedure :: Typeme 29 procedure :: Dealloc 30 end type list_t 31 32contains 33 subroutine Method(this) 34 class(list_t) :: this 35 integer :: i 36 do i = 1, 20 37 if (i .gt. 10) then 38 allocate (this%classes(i)%class_var, source = class_t (i)) 39 else 40 allocate (this%classes(i)%class_var, source = class_e (i, real (2 * i))) 41 end if 42 end do 43 end subroutine Method 44 subroutine Dealloc(this) 45 class(list_t) :: this 46 integer :: i 47 do i = 1, 20 48 if (allocated (this%classes(i)%class_var)) & 49 deallocate (this%classes(i)%class_var) 50 end do 51 end subroutine Dealloc 52 subroutine Typeme(this) 53 class(list_t) :: this 54 integer :: i, j(20) 55 real :: r(20) 56 real :: zero = 0.0 57 do i = 1, 20 58 j(i) = this%classes(i)%class_var%i 59 select type (p => this%classes(i)%class_var) 60 type is (class_e) 61 r(i) = p%r 62 class default 63 r(i) = zero 64 end select 65 end do 66! print "(10i6,/)", j 67 if (any (j .ne. [(i, i = 1,20)])) call abort 68! print "(10f6.2,/)", r 69 if (any (r(1:10) .ne. [(real (2 * i), i = 1,10)])) call abort 70 if (any (r(11:20) .ne. zero)) call abort 71 end subroutine Typeme 72end module test_mod 73 74 use test_mod 75 type(list_t) :: x 76 call x%Method 77 call x%Typeme 78 call x%dealloc 79end 80