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)
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 ! { dg-error "Unclassifiable statement" }
30    end select ! { dg-error "Expecting END FUNCTION" }
31  end function my_dot_v_v
32end module gfcbug111
33
34select type (a)
35! { dg-excess-errors "Unexpected end of file" }
36