1! { dg-do run } 2! 3! PR fortran/51514 4! 5! Check that passing a CLASS to a TYPE works 6! 7! Based on a test case of Reinhold Bader. 8! 9 10module mod_subpr 11 implicit none 12 13 type :: foo 14 integer :: i = 2 15 end type 16 17 type, extends(foo) :: foo_1 18 real :: r(2) 19 end type 20 21contains 22 23 subroutine subpr (x) 24 type(foo) :: x 25 x%i = 3 26 end subroutine 27 28 elemental subroutine subpr_elem (x) 29 type(foo), intent(inout):: x 30 x%i = 3 31 end subroutine 32 33 subroutine subpr_array (x) 34 type(foo), intent(inout):: x(:) 35 x(:)%i = 3 36 end subroutine 37 38 subroutine subpr2 (x) 39 type(foo) :: x 40 if (x%i /= 55) call abort () 41 end subroutine 42 43 subroutine subpr2_array (x) 44 type(foo) :: x(:) 45 if (any(x(:)%i /= 55)) call abort () 46 end subroutine 47 48 function f () 49 class(foo), allocatable :: f 50 allocate (f) 51 f%i = 55 52 end function f 53 54 function g () result(res) 55 class(foo), allocatable :: res(:) 56 allocate (res(3)) 57 res(:)%i = 55 58 end function g 59end module 60 61program prog 62 use mod_subpr 63 implicit none 64 class(foo), allocatable :: xx, yy(:) 65 66 allocate (foo_1 :: xx) 67 xx%i = 33 68 call subpr (xx) 69 if (xx%i /= 3) call abort () 70 71 xx%i = 33 72 call subpr_elem (xx) 73 if (xx%i /= 3) call abort () 74 75 call subpr (f ()) 76 77 allocate (foo_1 :: yy(2)) 78 yy(:)%i = 33 79 call subpr_elem (yy) 80 if (any (yy%i /= 3)) call abort () 81 82 yy(:)%i = 33 83 call subpr_elem (yy(1)) 84 if (yy(1)%i /= 3) call abort () 85 86 yy(:)%i = 33 87 call subpr_array (yy) 88 if (any (yy%i /= 3)) call abort () 89 90 yy(:)%i = 33 91 call subpr_array (yy(1:2)) 92 if (any (yy(1:2)%i /= 3)) call abort () 93 94 call subpr2_array (g ()) 95end program 96