1! { dg-do run }
2!
3! PR 44912: [OOP] Segmentation fault on TBP
4!
5! Contributed by Satish.BD <bdsatish@gmail.com>
6
7module polynomial
8implicit none
9
10private
11
12type, public :: polynom
13   complex, allocatable, dimension(:) :: a
14   integer :: n
15 contains
16   procedure :: init_from_coeff
17   procedure :: get_degree
18   procedure :: add_poly
19end type polynom
20
21contains
22  subroutine init_from_coeff(self, coeff)
23    class(polynom), intent(inout) :: self
24    complex, dimension(:), intent(in) :: coeff
25    self%n = size(coeff) - 1
26    allocate(self%a(self%n + 1))
27    self%a = coeff
28    print *,"ifc:",self%a
29  end subroutine init_from_coeff
30
31  function get_degree(self)   result(n)
32    class(polynom), intent(in) :: self
33    integer :: n
34    print *,"gd"
35    n = self%n
36  end function get_degree
37
38  subroutine add_poly(self)
39    class(polynom), intent(in) :: self
40    integer :: s
41    print *,"ap"
42    s = self%get_degree()         !!!! fails here
43  end subroutine
44
45end module polynomial
46
47program test_poly
48   use polynomial, only: polynom
49
50   type(polynom) :: p1
51
52   call p1%init_from_coeff([(1,0),(2,0),(3,0)])
53   call p1%add_poly()
54
55end program test_poly
56