From: kargl Date: Sat, 3 Feb 2007 01:01:06 +0000 (+0000) Subject: 2007-02-02 Steven G. Kargl X-Git-Url: http://git.sourceforge.jp/view?a=commitdiff_plain;h=9b6b0c8341314ca30d4bc571ad714c1819feebd5;p=pf3gnuchains%2Fgcc-fork.git 2007-02-02 Steven G. Kargl PR fortran/30683 * resolve.c (resolve_generic_f): Check for non-NULL sym. * gfortran.dg/interface_10.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@121531 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index edae9d64da1..0b256742474 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2007-02-02 Steven G. Kargl + + PR fortran/30683 + * resolve.c (resolve_generic_f): Check for non-NULL sym. + 2007-02-02 Roger Sayle * trans.c (gfc_build_array_ref): Use STRIP_TYPE_NOPS to eliminate diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 9a06a9820a3..41e13b0928f 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1315,7 +1315,7 @@ generic: /* Last ditch attempt. See if the reference is to an intrinsic that possesses a matching interface. 14.1.2.4 */ - if (!gfc_intrinsic_name (sym->name, 0)) + if (sym && !gfc_intrinsic_name (sym->name, 0)) { gfc_error ("There is no specific function for the generic '%s' at %L", expr->symtree->n.sym->name, &expr->where); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 01afd6f9b95..67b1ae96d69 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-02-02 Steven G. Kargl + + PR fortran/30683 + * gfortran.dg/interface_10.f90: New test. + 2007-02-02 Kaveh R. Ghazi * gcc.dg/builtins-20.c: Add more cases. diff --git a/gcc/testsuite/gfortran.dg/interface_10.f90 b/gcc/testsuite/gfortran.dg/interface_10.f90 new file mode 100644 index 00000000000..0da59a3b185 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_10.f90 @@ -0,0 +1,57 @@ +! { dg-do compile } +! PR fortran/30683 +! Code contributed by Salvatore Filippone. +! +module class_fld + integer, parameter :: int_ = 1 + integer, parameter :: bnd_ = 2 + type fld + integer :: size(2) + end type fld + ! + ! This interface is renaming the SIZE intrinsic procedure, + ! which led to a segmentation fault when trying to resolve + ! the intrinsic symbol name. + ! + interface size + module procedure get_fld_size + end interface +contains + function get_fld_size(f) + integer :: get_fld_size(2) + type(fld), intent(in) :: f + get_fld_size(int_) = f%size(int_) + get_fld_size(bnd_) = f%size(bnd_) + end function get_fld_size +end module class_fld + +module class_s_fld + use class_fld + type s_fld + type(fld) :: base + real(kind(1.d0)), pointer :: x(:) => null() + end type s_fld + interface x_ + module procedure get_s_fld_x + end interface +contains + function get_s_fld_x(fld) + real(kind(1.d0)), pointer :: get_s_fld_x(:) + type(s_fld), intent(in) :: fld + get_s_fld_x => fld%x + end function get_s_fld_x +end module class_s_fld + +module class_s_foo +contains + subroutine solve_s_foo(phi,var) + use class_s_fld + type(s_fld), intent(inout) :: phi + real(kind(1.d0)), intent(out), optional :: var + integer :: nsz + real(kind(1.d0)), pointer :: x(:) + x => x_(phi) + nsz=size(x) + end subroutine solve_s_foo +end module class_s_foo +! { dg-final { cleanup-modules "class_s_fld class_fld class_s_foo" } }