[Patch, fortran] PR31474 - ENTRY & procedural pointer: insert_bbt(): Duplicate key found!

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

This PR and its fix are straightforward.  The ChangeLog and the comments 
say it all.  The testcase is based on the original.

Bootstarpped and regtested on amd64/suse10.1 - OK for trunk?

Paul
2007-05-10  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31474
	* decl.c (get_proc_name): If an entry has already been declared
	as a module procedure, pick up the symbol and the symtree and
	use them for the entry.

2007-05-10  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31474
	* gfortran.dg/entry_10.f90: New test.

Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c	(revision 124335)
--- gcc/fortran/decl.c	(working copy)
*************** get_proc_name (const char *name, gfc_sym
*** 671,677 ****
       space is set to point to the master function, so that the fake
       result mechanism can work.  */
    if (module_fcn_entry)
!     rc = gfc_get_symbol (name, NULL, result);
    else
      rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
  
--- 671,682 ----
       space is set to point to the master function, so that the fake
       result mechanism can work.  */
    if (module_fcn_entry)
!     {
!       /* Present if entry is declared to be a module procedure.  */
!       rc = gfc_find_symbol (name, gfc_current_ns->parent, 0, result);
!       if (*result == NULL)
! 	rc = gfc_get_symbol (name, NULL, result);
!     }
    else
      rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
  
*************** get_proc_name (const char *name, gfc_sym
*** 712,718 ****
    /* Module function entries will already have a symtree in
       the current namespace but will need one at module level.  */
    if (module_fcn_entry)
!     st = gfc_new_symtree (&gfc_current_ns->parent->sym_root, name);
    else
      st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
  
--- 717,728 ----
    /* Module function entries will already have a symtree in
       the current namespace but will need one at module level.  */
    if (module_fcn_entry)
!     {
!       /* Present if entry is declared to be a module procedure.  */
!       rc = gfc_find_sym_tree (name, gfc_current_ns->parent, 0, &st);
!       if (st == NULL)
! 	st = gfc_new_symtree (&gfc_current_ns->parent->sym_root, name);
!     }
    else
      st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
  
*************** get_proc_name (const char *name, gfc_sym
*** 722,731 ****
    /* See if the procedure should be a module procedure */
  
    if (((sym->ns->proc_name != NULL
! 	&& sym->ns->proc_name->attr.flavor == FL_MODULE
! 	&& sym->attr.proc != PROC_MODULE) || module_fcn_entry)
!        && gfc_add_procedure (&sym->attr, PROC_MODULE,
! 			     sym->name, NULL) == FAILURE)
      rc = 2;
  
    return rc;
--- 732,742 ----
    /* See if the procedure should be a module procedure */
  
    if (((sym->ns->proc_name != NULL
! 		&& sym->ns->proc_name->attr.flavor == FL_MODULE
! 		&& sym->attr.proc != PROC_MODULE)
! 	    || (module_fcn_entry && sym->attr.proc != PROC_MODULE))
! 	&& gfc_add_procedure (&sym->attr, PROC_MODULE,
! 			      sym->name, NULL) == FAILURE)
      rc = 2;
  
    return rc;
Index: gcc/testsuite/gfortran.dg/entry_10.f90
===================================================================
*** gcc/testsuite/gfortran.dg/entry_10.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/entry_10.f90	(revision 0)
***************
*** 0 ****
--- 1,36 ----
+ ! { dg-do run }
+ ! Test fix for PR31474, in which the use of ENTRYs as module
+ ! procedures in a generic interface would cause an internal error.
+ !
+ ! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+ !
+ module a
+   interface b
+     module procedure c, d
+   end interface
+ contains
+   real function d (i)
+     real c, i
+     integer j
+     d = 1.0
+     return
+   entry c (j)
+     d = 2.0
+   end function
+   real function e (i)
+     real f, i
+     integer j
+     e = 3.0
+     return
+   entry f (j)
+     e = 4.0
+   end function
+ end module
+ 
+   use a
+   if (b (1.0) .ne. 1.0) call abort ()
+   if (b (1  ) .ne. 2.0) call abort ()
+   if (e (1.0) .ne. 3.0) call abort ()
+   if (f (1  ) .ne. 4.0) call abort ()
+ end
+ ! { dg-final { cleanup-modules "a" } }