1! { dg-do compile }
2! PR fortran/45848
3! PR fortran/47204
4!
5! Contributed by Harald Anlauf and Zdenek Sojka
6!
7module gfcbug111
8  implicit none
9
10  type, abstract :: inner_product_class
11  end type inner_product_class
12
13  type, extends(inner_product_class) :: trivial_inner_product_type
14  end type trivial_inner_product_type
15
16contains
17
18  function my_dot_v_v (this,a,b)       ! { dg-error "has no IMPLICIT type" }
19    class(trivial_inner_product_type), intent(in) :: this
20    class(vector_class),               intent(in) :: a,b ! { dg-error "Derived type" }
21    real :: my_dot_v_v
22
23    select type (a)                    ! { dg-error "Selector shall be polymorphic" }
24    class is (trivial_vector_type)     ! { dg-error "Syntax error in CLASS IS" }
25       select type (b)                 ! { dg-error "Expected TYPE IS" }
26       class is (trivial_vector_type)  ! { dg-error "Syntax error in CLASS IS" }
27       class default
28       end select
29    class default
30    end select ! { dg-error "Expecting END FUNCTION" }
31  end function my_dot_v_v
32end module gfcbug111
33
34select type (a)
35! { dg-prune-output "Unexpected end of file" }
36