! { dg-do run }
|
! { dg-do run }
|
! This tests the "virtual fix" for PR19561, where functions returning
|
! This tests the "virtual fix" for PR19561, where functions returning
|
! pointers to derived types were not generating correct code. This
|
! pointers to derived types were not generating correct code. This
|
! testcase is based on a simplified example in the PR discussion.
|
! testcase is based on a simplified example in the PR discussion.
|
!
|
!
|
! Submitted by Paul Thomas pault@gcc.gnu.org
|
! Submitted by Paul Thomas pault@gcc.gnu.org
|
! Slightly extended by Tobias Schlüter
|
! Slightly extended by Tobias Schlüter
|
module mpoint
|
module mpoint
|
type :: mytype
|
type :: mytype
|
integer :: i
|
integer :: i
|
end type mytype
|
end type mytype
|
|
|
contains
|
contains
|
|
|
function get (a) result (b)
|
function get (a) result (b)
|
type (mytype), target :: a
|
type (mytype), target :: a
|
type (mytype), pointer :: b
|
type (mytype), pointer :: b
|
b => a
|
b => a
|
end function get
|
end function get
|
|
|
function get2 (a)
|
function get2 (a)
|
type (mytype), target :: a
|
type (mytype), target :: a
|
type (mytype), pointer :: get2
|
type (mytype), pointer :: get2
|
get2 => a
|
get2 => a
|
end function get2
|
end function get2
|
|
|
end module mpoint
|
end module mpoint
|
|
|
program func_derived_2
|
program func_derived_2
|
use mpoint
|
use mpoint
|
type (mytype), target :: x
|
type (mytype), target :: x
|
type (mytype), pointer :: y
|
type (mytype), pointer :: y
|
x = mytype (42)
|
x = mytype (42)
|
y => get (x)
|
y => get (x)
|
if (y%i.ne.42) call abort ()
|
if (y%i.ne.42) call abort ()
|
|
|
x = mytype (112)
|
x = mytype (112)
|
y => get2 (x)
|
y => get2 (x)
|
if (y%i.ne.112) call abort ()
|
if (y%i.ne.112) call abort ()
|
end program func_derived_2
|
end program func_derived_2
|
|
|
! { dg-final { cleanup-modules "mpoint" } }
|
! { dg-final { cleanup-modules "mpoint" } }
|
|
|
