|
111
|
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 extending 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
|
