1! { dg-do compile }
2!
3! PR 46662: [OOP] gfortran accepts "CALL polymorphic%abstract_type%ppc()"
4!
5! Contributed by Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
6! cf. http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/a0857fa4a692d518
7
8module types
9  implicit none
10
11  type, abstract :: base_t
12     integer :: i = 0
13     procedure(base_write_i), pointer :: write_procptr
14   contains
15     procedure :: write_i => base_write_i
16  end type base_t
17
18  type, extends (base_t) :: t
19  end type t
20
21contains
22
23  subroutine base_write_i (obj)
24    class (base_t), intent(in) :: obj
25    print *, obj%i
26  end subroutine base_write_i
27
28end module types
29
30
31program main
32  use types
33  implicit none
34
35  type(t) :: obj
36
37  print *, "Direct printing"
38  obj%i = 1
39  print *, obj%i
40
41  print *, "Direct printing via parent"
42  obj%base_t%i = 2
43  print *, obj%base_t%i
44
45  print *, "Printing via TBP"
46  obj%i = 3
47  call obj%write_i
48
49  print *, "Printing via parent TBP"
50  obj%base_t%i = 4
51  call obj%base_t%write_i      ! { dg-error "is of ABSTRACT type" }
52
53  print *, "Printing via OBP"
54  obj%i = 5
55  obj%write_procptr => base_write_i
56  call obj%write_procptr
57
58  print *, "Printing via parent OBP"
59  obj%base_t%i = 6
60  obj%base_t%write_procptr => base_write_i
61  call obj%base_t%write_procptr               ! { dg-error "is of ABSTRACT type" }
62
63end program main
64