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