[Fortran, committed] Fix PR fortran/30683

Steve Kargl sgk@troutmask.apl.washington.edu
Sat Feb 3 01:03:00 GMT 2007


I've committed the attached patch under the obviously
correct rule.

2007-02-02  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/30683
    * resolve.c (resolve_generic_f): Check for non-NULL sym.
	* gfortran.dg/interface_10.f90: New test.

-- 
Steve
-------------- next part --------------
Index: resolve.c
===================================================================
--- resolve.c	(revision 121352)
+++ resolve.c	(working copy)
@@ -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);
-------------- next part --------------
! { 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" } }


More information about the Fortran mailing list