OSDN Git Service

0da59a3b1850c1dc2a2fd3e63d47473d22be05dc
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / interface_10.f90
1 ! { dg-do compile }
2 ! PR fortran/30683
3 ! Code contributed by Salvatore Filippone.
4 !
5 module class_fld
6    integer, parameter :: int_ = 1
7   integer, parameter :: bnd_ = 2
8   type fld
9      integer                 :: size(2)
10   end type fld
11   !
12   !  This interface is renaming the SIZE intrinsic procedure,  
13   !  which led to a segmentation fault when trying to resolve
14   !  the intrinsic symbol name.
15   !
16   interface size
17      module procedure get_fld_size
18   end interface
19 contains
20   function get_fld_size(f)
21     integer :: get_fld_size(2)
22     type(fld), intent(in) :: f
23     get_fld_size(int_) = f%size(int_)
24     get_fld_size(bnd_) = f%size(bnd_)
25   end function get_fld_size
26 end module class_fld
27
28 module class_s_fld
29   use class_fld
30   type s_fld
31      type(fld) :: base
32      real(kind(1.d0)), pointer :: x(:)  => null()
33   end type s_fld
34   interface x_
35      module procedure get_s_fld_x
36   end interface
37 contains
38   function get_s_fld_x(fld)
39     real(kind(1.d0)), pointer :: get_s_fld_x(:)
40     type(s_fld), intent(in) :: fld
41     get_s_fld_x => fld%x
42   end function get_s_fld_x
43 end module class_s_fld
44
45 module class_s_foo
46 contains
47   subroutine solve_s_foo(phi,var)
48     use class_s_fld
49     type(s_fld), intent(inout) :: phi
50     real(kind(1.d0)), intent(out), optional :: var
51     integer :: nsz
52     real(kind(1.d0)), pointer :: x(:)
53     x => x_(phi)
54     nsz=size(x)
55   end subroutine solve_s_foo
56 end module class_s_foo
57 ! { dg-final { cleanup-modules "class_s_fld class_fld class_s_foo" } }