1! { dg-do run } 2! Testing fix for 3! PR fortran/60414 4! 5module m 6 implicit none 7 Type T 8 real, public :: expectedScalar; 9 contains 10 procedure :: FCheck 11 procedure :: FCheckArr 12 generic :: Check => FCheck, FCheckArr 13 end Type 14 15contains 16 17 subroutine FCheck(this,X) 18 class(T) this 19 class(*) X 20 real :: r 21 select type (X) 22 type is (real) 23 if ( abs (X - this%expectedScalar) > 0.0001 ) then 24 call abort() 25 end if 26 class default 27 call abort () 28 end select 29 end subroutine FCheck 30 31 subroutine FCheckArr(this,X) 32 class(T) this 33 class(*) X(:) 34 integer i 35 do i = 1,6 36 this%expectedScalar = i - 1.0 37 call this%FCheck(X(i)) 38 end do 39 end subroutine FCheckArr 40 41 subroutine CheckTextVector(vec, n, scal) 42 integer, intent(in) :: n 43 class(*), intent(in) :: vec(n) 44 class(*), intent(in) :: scal 45 integer j 46 Type(T) :: Tester 47 48 ! Check full vector 49 call Tester%Check(vec) 50 ! Check a scalar of the same class like the vector 51 Tester%expectedScalar = 5.0 52 call Tester%Check(scal) 53 ! Check an element of the vector, which is a scalar 54 j=3 55 Tester%expectedScalar = 2.0 56 call Tester%Check(vec(j)) 57 58 end subroutine CheckTextVector 59 60end module 61 62program test 63 use :: m 64 implicit none 65 66 real :: vec(1:6) = (/ 0, 1, 2, 3, 4, 5 /) 67 call checktextvector(vec, 6, 5.0) 68end program test 69 70