1! { dg-do compile }
2! Test the fix for PR43266, in which an ICE followed correct error messages.
3!
4! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
5! Reported in http://groups.google.ca/group/comp.lang.fortran/browse_thread/thread/f5ec99089ea72b79
6!
7!----------------
8! library code
9
10module m
11TYPE, ABSTRACT :: top
12CONTAINS
13   PROCEDURE(xxx), DEFERRED :: proc_a ! { dg-error "must be explicit" }
14   ! some useful default behaviour
15   PROCEDURE :: proc_c => top_c ! { dg-error "must be a module procedure" }
16END TYPE top
17
18! Concrete middle class with useful behaviour
19TYPE, EXTENDS(top) :: middle
20CONTAINS
21   ! do nothing, empty proc just to make middle concrete
22   PROCEDURE :: proc_a => dummy_middle_a ! { dg-error "must be a module procedure" }
23   ! some useful default behaviour
24   PROCEDURE :: proc_b => middle_b ! { dg-error "must be a module procedure" }
25END TYPE middle
26
27!----------------
28! client code
29
30TYPE, EXTENDS(middle) :: bottom
31CONTAINS
32   ! useful proc to satisfy deferred procedure in top. Because we've
33   ! extended middle we wouldn't get told off if we forgot this.
34   PROCEDURE :: proc_a => bottom_a  ! { dg-error "must be a module procedure" }
35   ! calls middle%proc_b and then provides extra behaviour
36   PROCEDURE :: proc_b => bottom_b
37   ! calls top_c and then provides extra behaviour
38   PROCEDURE :: proc_c => bottom_c
39END TYPE bottom
40contains
41SUBROUTINE bottom_b(obj)
42   CLASS(Bottom) :: obj
43   CALL obj%middle%proc_b ! { dg-error "should be a SUBROUTINE" }
44   ! other stuff
45END SUBROUTINE bottom_b
46
47SUBROUTINE bottom_c(obj)
48   CLASS(Bottom) :: obj
49   CALL top_c(obj)
50   ! other stuff
51END SUBROUTINE bottom_c 
52end module
53