Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/interface_10.f90 @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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