1! { dg-do compile } 2! PR fortran/30683 3! Code contributed by Salvatore Filippone. 4! 5module 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 19contains 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 26end module class_fld 27 28module 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 37contains 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 43end module class_s_fld 44 45module class_s_foo 46contains 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 56end module class_s_foo 57