[Patch, fortran] PR33499 - Rejects valid module with a contained function with an ENTRY

["Paul Richard Thomas" <paul dot richard dot thomas at gmail dot com>]

:ADDPATCH fortran:

This patch is self-explanatory.  The particular case of an ENTRY that
was also a MODULE PROCEDURE, which had not yet had its characteristics
declared, was triply blighted:
(i) It was excluded by the if statement
(ii) The residual, hidden symbol was untyped and so caused an error
(iii) The symbol for the ENTRY was put in the wrong namespace.
The testcase is the reporter's, except that I have changed the
components to integer, so that the equality is always good and
embellished the type(cx) with a real part.

Bootstraps and regtests on x86_ia64 - OK for trunk?

PR31213 will have to wait until tomorrow.

Cheers

Paul

2007-11-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33499
	* decl.c (get_proc_name): If ENTRY statement occurs before type
	specification, set the symbol untyped and ensure that it is in
	the procedure namespace.

2007-11-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33499
	* gfortran.dg/entry_16.f90: New test.

-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy

Index: /svn/trunk/gcc/fortran/decl.c
===================================================================
*** /svn/trunk/gcc/fortran/decl.c	(revision 130394)
--- /svn/trunk/gcc/fortran/decl.c	(working copy)
*************** get_proc_name (const char *name, gfc_sym
*** 715,723 ****
  
        if (*result == NULL)
  	rc = gfc_get_symbol (name, NULL, result);
!       else if (gfc_get_symbol (name, NULL, &sym) == 0
! 		 && sym
! 		 && sym->ts.type != BT_UNKNOWN
  		 && (*result)->ts.type == BT_UNKNOWN
  		 && sym->attr.flavor == FL_UNKNOWN)
  	/* Pick up the typespec for the entry, if declared in the function
--- 715,721 ----
  
        if (*result == NULL)
  	rc = gfc_get_symbol (name, NULL, result);
!       else if (!gfc_get_symbol (name, NULL, &sym) && sym
  		 && (*result)->ts.type == BT_UNKNOWN
  		 && sym->attr.flavor == FL_UNKNOWN)
  	/* Pick up the typespec for the entry, if declared in the function
*************** get_proc_name (const char *name, gfc_sym
*** 726,738 ****
  	   is set to point to the module symbol and a unique symtree
  	   to the local version.  This latter ensures a correct clearing
  	   of the symbols.  */
! 	  {
  	    (*result)->ts = sym->ts;
! 	    gfc_find_sym_tree (name, gfc_current_ns, 0, &st);
! 	    st->n.sym = *result;
! 	    st = gfc_get_unique_symtree (gfc_current_ns);
! 	    st->n.sym = sym;
! 	  }
      }
    else
      rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
--- 724,747 ----
  	   is set to point to the module symbol and a unique symtree
  	   to the local version.  This latter ensures a correct clearing
  	   of the symbols.  */
! 	{
! 	  /* If the ENTRY proceeds its specification, we need to ensure
! 	     that this does not raise a "has no IMPLICIT type" error.  */
! 	  if (sym->ts.type == BT_UNKNOWN)
! 		sym->attr.untyped = 1;
! 
  	    (*result)->ts = sym->ts;
! 
! 	  /* Put the symbol in the procedure namespace so that, should
! 	     the ENTRY preceed its specification, the specification
! 	     can be applied.  */
! 	  (*result)->ns = gfc_current_ns;
! 
! 	  gfc_find_sym_tree (name, gfc_current_ns, 0, &st);
! 	  st->n.sym = *result;
! 	  st = gfc_get_unique_symtree (gfc_current_ns);
! 	  st->n.sym = sym;
! 	}
      }
    else
      rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
Index: /svn/trunk/gcc/testsuite/gfortran.dg/entry_16.f90
===================================================================
*** /svn/trunk/gcc/testsuite/gfortran.dg/entry_16.f90	(revision 0)
--- /svn/trunk/gcc/testsuite/gfortran.dg/entry_16.f90	(revision 0)
***************
*** 0 ****
--- 1,43 ----
+ ! { dg-do run }
+ ! Tests the fix for PR33499 in which the ENTRY cx_radc was not
+ ! getting its TYPE.
+ !
+ ! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+ !
+ MODULE complex
+   IMPLICIT NONE
+   PRIVATE
+   PUBLIC :: cx, OPERATOR(+), OPERATOR(.eq.)
+   TYPE cx
+     integer :: re
+     integer :: im
+   END TYPE cx
+   INTERFACE OPERATOR (+)
+     MODULE PROCEDURE cx_cadr, cx_radc
+   END INTERFACE
+   INTERFACE OPERATOR (.eq.)
+     MODULE PROCEDURE cx_eq
+   END INTERFACE
+   CONTAINS
+   FUNCTION cx_cadr(z, r)
+   ENTRY cx_radc(r, z)
+     TYPE (cx) :: cx_cadr, cx_radc
+     TYPE (cx), INTENT(IN) :: z
+     integer, INTENT(IN) :: r
+     cx_cadr%re = z%re + r
+     cx_cadr%im = z%im
+   END FUNCTION cx_cadr
+   FUNCTION cx_eq(u, v)
+     TYPE (cx), INTENT(IN) :: u, v
+     logical :: cx_eq
+     cx_eq = (u%re .eq. v%re) .and. (u%im .eq. v%im)
+   END FUNCTION cx_eq
+ END MODULE complex
+ 
+   use complex
+   type(cx) :: a = cx (1, 2), c, d
+   logical :: f
+   integer :: b = 3
+   if (.not.((a + b) .eq. (b + a))) call abort ()
+   if (.not.((a + b) .eq. cx (4, 2))) call abort ()
+ end