blob: 3118b552a3013591da3c6669caec9763ae1411aa [file] [log] [blame]
! { dg-do run }
! { dg-options "-Wreturn-type" }
!
! Check that pr58586 is fixed now.
! Based on a contribution by Vladimir Fuka
! Contibuted by Andre Vehreschild
module test_pr58586_mod
implicit none
type :: a
end type
type :: c
type(a), allocatable :: a
end type
type :: d
contains
procedure :: init => d_init
end type
type, extends(d) :: e
contains
procedure :: init => e_init
end type
type :: b
integer, allocatable :: a
end type
type t
integer :: i = 5
end type
contains
subroutine add (d)
type(b), value :: d
end subroutine
subroutine add_c (d)
type(c), value :: d
end subroutine
subroutine add_class_c (d)
class(c), value :: d
end subroutine
subroutine add_t (d)
type(t), value :: d
end subroutine
type(c) function c_init() ! { dg-warning "not set" }
end function
class(c) function c_init2() ! { dg-warning "not set" }
allocatable :: c_init2
end function
type(c) function d_init(this) ! { dg-warning "not set" }
class(d) :: this
end function
type(c) function e_init(this)
class(e) :: this
allocate (e_init%a)
end function
type(t) function t_init() ! { dg-warning "not set" }
allocatable :: t_init
end function
type(t) function static_t_init() ! { dg-warning "not set" }
end function
end module test_pr58586_mod
program test_pr58586
use test_pr58586_mod
class(d), allocatable :: od
class(e), allocatable :: oe
type(t), allocatable :: temp
! These two are merely to check, if compilation works
call add(b())
call add(b(null()))
! This needs to execute, to see whether the segfault at runtime is resolved
call add_c(c_init())
call add_class_c(c_init2())
call add_t(static_t_init())
! temp = t_init() ! <-- This derefs a null-pointer currently
! Filed as pr66775
if (allocated (temp)) STOP 1
allocate(od)
call add_c(od%init())
deallocate(od)
allocate(oe)
call add_c(oe%init())
deallocate(oe)
end program