! { dg-do compile }
|
! { dg-do compile }
|
! PR fortran/30683
|
! PR fortran/30683
|
! Code contributed by Salvatore Filippone.
|
! Code contributed by Salvatore Filippone.
|
!
|
!
|
module class_fld
|
module class_fld
|
integer, parameter :: int_ = 1
|
integer, parameter :: int_ = 1
|
integer, parameter :: bnd_ = 2
|
integer, parameter :: bnd_ = 2
|
type fld
|
type fld
|
integer :: size(2)
|
integer :: size(2)
|
end type fld
|
end type fld
|
!
|
!
|
! This interface is renaming the SIZE intrinsic procedure,
|
! This interface is renaming the SIZE intrinsic procedure,
|
! which led to a segmentation fault when trying to resolve
|
! which led to a segmentation fault when trying to resolve
|
! the intrinsic symbol name.
|
! the intrinsic symbol name.
|
!
|
!
|
interface size
|
interface size
|
module procedure get_fld_size
|
module procedure get_fld_size
|
end interface
|
end interface
|
contains
|
contains
|
function get_fld_size(f)
|
function get_fld_size(f)
|
integer :: get_fld_size(2)
|
integer :: get_fld_size(2)
|
type(fld), intent(in) :: f
|
type(fld), intent(in) :: f
|
get_fld_size(int_) = f%size(int_)
|
get_fld_size(int_) = f%size(int_)
|
get_fld_size(bnd_) = f%size(bnd_)
|
get_fld_size(bnd_) = f%size(bnd_)
|
end function get_fld_size
|
end function get_fld_size
|
end module class_fld
|
end module class_fld
|
|
|
module class_s_fld
|
module class_s_fld
|
use class_fld
|
use class_fld
|
type s_fld
|
type s_fld
|
type(fld) :: base
|
type(fld) :: base
|
real(kind(1.d0)), pointer :: x(:) => null()
|
real(kind(1.d0)), pointer :: x(:) => null()
|
end type s_fld
|
end type s_fld
|
interface x_
|
interface x_
|
module procedure get_s_fld_x
|
module procedure get_s_fld_x
|
end interface
|
end interface
|
contains
|
contains
|
function get_s_fld_x(fld)
|
function get_s_fld_x(fld)
|
real(kind(1.d0)), pointer :: get_s_fld_x(:)
|
real(kind(1.d0)), pointer :: get_s_fld_x(:)
|
type(s_fld), intent(in) :: fld
|
type(s_fld), intent(in) :: fld
|
get_s_fld_x => fld%x
|
get_s_fld_x => fld%x
|
end function get_s_fld_x
|
end function get_s_fld_x
|
end module class_s_fld
|
end module class_s_fld
|
|
|
module class_s_foo
|
module class_s_foo
|
contains
|
contains
|
subroutine solve_s_foo(phi,var)
|
subroutine solve_s_foo(phi,var)
|
use class_s_fld
|
use class_s_fld
|
type(s_fld), intent(inout) :: phi
|
type(s_fld), intent(inout) :: phi
|
real(kind(1.d0)), intent(out), optional :: var
|
real(kind(1.d0)), intent(out), optional :: var
|
integer :: nsz
|
integer :: nsz
|
real(kind(1.d0)), pointer :: x(:)
|
real(kind(1.d0)), pointer :: x(:)
|
x => x_(phi)
|
x => x_(phi)
|
nsz=size(x)
|
nsz=size(x)
|
end subroutine solve_s_foo
|
end subroutine solve_s_foo
|
end module class_s_foo
|
end module class_s_foo
|
! { dg-final { cleanup-modules "class_s_fld class_fld class_s_foo" } }
|
! { dg-final { cleanup-modules "class_s_fld class_fld class_s_foo" } }
|
|
|
