1! { dg-do run } 2! Tests fix for PR60717 in which offsets in recursive calls below 3! were not being set correctly. 4! 5! Reported on comp.lang.fortran by Thomas Schnurrenberger 6! 7module m 8 implicit none 9 real :: chksum0 = 0, chksum1 = 0, chksum2 = 0 10contains 11 recursive subroutine show_real(a) 12 real, intent(in) :: a(:) 13 if (size (a) > 0) then 14 chksum0 = a(1) + chksum0 15 call show_real (a(2:)) 16 end if 17 return 18 end subroutine show_real 19 recursive subroutine show_generic1(a) 20 class(*), intent(in) :: a(:) 21 if (size (a) > 0) then 22 select type (a) 23 type is (real) 24 chksum1 = a(1) + chksum1 25 end select 26 call show_generic1 (a(2:)) ! recursive call outside SELECT TYPE 27 end if 28 return 29 end subroutine show_generic1 30 recursive subroutine show_generic2(a) 31 class(*), intent(in) :: a(:) 32 if (size (a) > 0) then 33 select type (a) 34 type is (real) 35 chksum2 = a(1) + chksum2 36 call show_generic2 (a(2:)) ! recursive call inside SELECT TYPE 37 end select 38 end if 39 return 40 end subroutine show_generic2 41end module m 42program test 43 use :: m 44 implicit none 45 real :: array(1:6) = (/ 0, 1, 2, 3, 4, 5 /) 46 call show_real (array) 47 call show_generic1 (array) 48 call show_generic2 (array) 49 if (chksum0 .ne. chksum1) call abort 50 if (chksum0 .ne. chksum2) call abort 51end program test 52