! { dg-do run } ! PR fortran/30793 ! Check that pointer-returing functions ! work derived types. ! ! Contributed by Salvatore Filippone. ! module class_mesh type mesh real(kind(1.d0)), allocatable :: area(:) end type mesh contains subroutine create_mesh(msh) type(mesh), intent(out) :: msh allocate(msh%area(10)) return end subroutine create_mesh end module class_mesh module class_field use class_mesh implicit none private ! Default public :: create_field, field public :: msh_ type field private type(mesh), pointer :: msh => null() integer :: isize(2) end type field interface msh_ module procedure msh_ end interface interface create_field module procedure create_field end interface contains subroutine create_field(fld,msh) type(field), intent(out) :: fld type(mesh), intent(in), target :: msh fld%msh => msh fld%isize = 1 end subroutine create_field function msh_(fld) type(mesh), pointer :: msh_ type(field), intent(in) :: fld msh_ => fld%msh end function msh_ end module class_field module class_scalar_field use class_field implicit none private public :: create_field, scalar_field public :: msh_ type scalar_field private type(field) :: base real(kind(1.d0)), allocatable :: x(:) real(kind(1.d0)), allocatable :: bx(:) real(kind(1.d0)), allocatable :: x_old(:) end type scalar_field interface create_field module procedure create_scalar_field end interface interface msh_ module procedure get_scalar_field_msh end interface contains subroutine create_scalar_field(fld,msh) use class_mesh type(scalar_field), intent(out) :: fld type(mesh), intent(in), target :: msh call create_field(fld%base,msh) allocate(fld%x(10),fld%bx(20)) end subroutine create_scalar_field function get_scalar_field_msh(fld) use class_mesh type(mesh), pointer :: get_scalar_field_msh type(scalar_field), intent(in), target :: fld get_scalar_field_msh => msh_(fld%base) end function get_scalar_field_msh end module class_scalar_field program test_pnt use class_mesh use class_scalar_field implicit none type(mesh) :: msh type(mesh), pointer :: mshp type(scalar_field) :: quality call create_mesh(msh) call create_field(quality,msh) mshp => msh_(quality) end program test_pnt ! { dg-final { cleanup-modules "class_mesh class_field class_scalar_field" } }