[Patch, fortran] PR29464 - problem with duplicate USE, ONLY of procedure in INTERFACE

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

This represents another contribution in campaign to eliminate the 
interface meta-bug PR29670.

The patch is completely straightforward and adds a search for the "real" 
name of a generic interface for all it's local names, in the same way as 
is done for symbols.  An symbol_attribute field, generic_copy was added 
so that the interface could be shared between different symbols and the 
clean up of the namespace would only free it once.  The testcase is the 
reporter's.

Regtested on Cygwin_NT/amd64 - OK for trunk, 4.2 and 4.1?

Paul

PS Could somebody look at the patches for PRs 29821, 29912 and 29916 
over the next few days, please?

2006-11-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29464
	* module.c (load_generic_interfaces): Add symbols for all the
	local names of an interface.  Share the interface amongst the
	symbols.
	* gfortran.h : Add generic_copy to symbol_attribute.
	* symbol.c (free_symbol): Only free interface if generic_copy
	is not set.

2006-11-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29464
	* gfortran.dg/module_interface_2.f90: New test.

Index: gcc/fortran/symbol.c
===================================================================
*** gcc/fortran/symbol.c	(revision 119172)
--- gcc/fortran/symbol.c	(working copy)
*************** gfc_free_symbol (gfc_symbol * sym)
*** 1931,1937 ****
  
    gfc_free_namespace (sym->formal_ns);
  
!   gfc_free_interface (sym->generic);
  
    gfc_free_formal_arglist (sym->formal);
  
--- 1931,1938 ----
  
    gfc_free_namespace (sym->formal_ns);
  
!   if (!sym->attr.generic_copy)
!     gfc_free_interface (sym->generic);
  
    gfc_free_formal_arglist (sym->formal);
  
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h	(revision 119172)
--- gcc/fortran/gfortran.h	(working copy)
*************** typedef struct
*** 483,489 ****
      use_assoc:1;		/* Symbol has been use-associated.  */
  
    unsigned in_namelist:1, in_common:1, in_equivalence:1;
!   unsigned function:1, subroutine:1, generic:1;
    unsigned implicit_type:1;	/* Type defined via implicit rules.  */
    unsigned untyped:1;           /* No implicit type could be found.  */
  
--- 483,489 ----
      use_assoc:1;		/* Symbol has been use-associated.  */
  
    unsigned in_namelist:1, in_common:1, in_equivalence:1;
!   unsigned function:1, subroutine:1, generic:1, generic_copy:1;
    unsigned implicit_type:1;	/* Type defined via implicit rules.  */
    unsigned untyped:1;           /* No implicit type could be found.  */
  
Index: gcc/fortran/module.c
===================================================================
*** gcc/fortran/module.c	(revision 119172)
--- gcc/fortran/module.c	(working copy)
*************** load_generic_interfaces (void)
*** 3018,3023 ****
--- 3018,3025 ----
    const char *p;
    char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1];
    gfc_symbol *sym;
+   gfc_interface *generic = NULL;
+   int n, i;
  
    mio_lparen ();
  
*************** load_generic_interfaces (void)
*** 3028,3052 ****
        mio_internal_string (name);
        mio_internal_string (module);
  
!       /* Decide if we need to load this one or not.  */
!       p = find_use_name (name);
  
!       if (p == NULL || gfc_find_symbol (p, NULL, 0, &sym))
  	{
! 	  while (parse_atom () != ATOM_RPAREN);
! 	  continue;
! 	}
  
!       if (sym == NULL)
! 	{
! 	  gfc_get_symbol (p, NULL, &sym);
  
! 	  sym->attr.flavor = FL_PROCEDURE;
! 	  sym->attr.generic = 1;
! 	  sym->attr.use_assoc = 1;
! 	}
  
!       mio_interface_rest (&sym->generic);
      }
  
    mio_rparen ();
--- 3030,3068 ----
        mio_internal_string (name);
        mio_internal_string (module);
  
!       n = number_use_names (name);
!       n = n ? n : 1;
  
!       for (i = 1; i <= n; i++)
  	{
! 	  /* Decide if we need to load this one or not.  */
! 	  p = find_use_name_n (name, &i);
  
! 	  if (p == NULL || gfc_find_symbol (p, NULL, 0, &sym))
! 	    {
! 	      while (parse_atom () != ATOM_RPAREN);
! 	        continue;
! 	    }
  
! 	  if (sym == NULL)
! 	    {
! 	      gfc_get_symbol (p, NULL, &sym);
  
! 	      sym->attr.flavor = FL_PROCEDURE;
! 	      sym->attr.generic = 1;
! 	      sym->attr.use_assoc = 1;
! 	    }
! 	  if (i == 1)
! 	    {
! 	      mio_interface_rest (&sym->generic);
! 	      generic = sym->generic;
! 	    }
! 	  else
! 	    {
! 	      sym->generic = generic;
! 	      sym->attr.generic_copy = 1;
! 	    }
! 	}
      }
  
    mio_rparen ();

! { dg-do compile }
! Tests the fix for PR29464, in which the second USE of the generic
! interface caused an error.
!
! Contributed by Vivek Rao <vivekrao4@yahoo.com>
!
module foo_mod
  implicit none
  interface twice
     module procedure twice_real
  end interface twice
contains
  real function twice_real(x)
    real :: x
    twice_real = 2*x
  end function twice_real
end module foo_mod

  subroutine foobar ()
    use foo_mod, only: twice, twice
    print *, twice (99.0)
  end subroutine foobar

  program xfoo
  use foo_mod, only: two => twice, dbl => twice
  implicit none
  call foobar ()
  print *, two (2.3)
  print *, dbl (2.3)
end program xfoo
! { dg-final { cleanup-modules "foo_mod" } }