2007-08-04 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/31214
	* symbol.c (get_unique_symtree): Moved from module.c.
	* module.c (get_unique_symtree): Moved to symbol.c.
	* decl.c (get_proc_name): Transfer the typespec from the local
	symbol to the module symbol, in the case that an entry is also
	a module procedure.  Ensure the local symbol is cleaned up by
	pointing to it with a unique symtree.

	* dump_parse_tree (gfc_show_code_node): Add EXEC_ASSIGN_CALL.

2007-08-04  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31214
	* gfortran.dg/entry_13.f90: New test.

	* gfortran.dg/entry_12.f90: Clean up .mod file.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127213 138bc75d-0d04-0410-961f-82ee72b054a4

9 files changed, 161 insertions, 53 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2e29300e7be..e9b2ed30682 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2007-08-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31214
+	* gfortran.dg/entry_13.f90: New test.
+
+	* gfortran.dg/entry_12.f90: Clean up .mod file.
+
 2008-08-04  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/32969
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index a94085fce18..d674aeb92e1 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -681,8 +681,27 @@ get_proc_name (const char *name, gfc_symbol **result, bool 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 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
+	   body.  Note that this symbol is FL_UNKNOWN because it will
+	   only have appeared in a type declaration.  The local symtree
+	   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);
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index c99fc425375..ac6a6f5d7b8 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1084,6 +1084,7 @@ gfc_show_code_node (int level, gfc_code *c)
       break;
 
     case EXEC_CALL:
+    case EXEC_ASSIGN_CALL:
       if (c->resolved_sym)
 	gfc_status ("CALL %s ", c->resolved_sym->name);
       else if (c->symtree)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a87366f8e49..329fae2103f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2124,6 +2124,7 @@ gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
 gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
 gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
 gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
+gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
 gfc_user_op *gfc_get_uop (const char *);
 gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
 void gfc_free_symbol (gfc_symbol *);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index fc30eae7732..baba5c7434c 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1822,20 +1822,6 @@ mio_charlen (gfc_charlen **clp)
 }
 
 
-/* Return a symtree node with a name that is guaranteed to be unique
-   within the namespace and corresponds to an illegal fortran name.  */
-
-static gfc_symtree *
-get_unique_symtree (gfc_namespace *ns)
-{
-  char name[GFC_MAX_SYMBOL_LEN + 1];
-  static int serial = 0;
-
-  sprintf (name, "@%d", serial++);
-  return gfc_new_symtree (&ns->sym_root, name);
-}
-
-
 /* See if a name is a generated name.  */
 
 static int
@@ -2287,7 +2273,7 @@ mio_symtree_ref (gfc_symtree **stp)
       if (in_load_equiv && p->u.rsym.symtree == NULL)
 	{
 	  /* Since this is not used, it must have a unique name.  */
-	  p->u.rsym.symtree = get_unique_symtree (gfc_current_ns);
+	  p->u.rsym.symtree = gfc_get_unique_symtree (gfc_current_ns);
 
 	  /* Make the symbol.  */
 	  if (p->u.rsym.sym == NULL)
@@ -3418,7 +3404,7 @@ read_cleanup (pointer_info *p)
     {
       /* Add hidden symbols to the symtree.  */
       q = get_integer (p->u.rsym.ns);
-      st = get_unique_symtree ((gfc_namespace *) q->u.pointer);
+      st = gfc_get_unique_symtree ((gfc_namespace *) q->u.pointer);
 
       st->n.sym = p->u.rsym.sym;
       st->n.sym->refs++;
@@ -3598,7 +3584,7 @@ read_module (void)
 	      /* Create a symtree node in the current namespace for this
 		 symbol.  */
 	      st = check_unique_name (p)
-		   ? get_unique_symtree (gfc_current_ns)
+		   ? gfc_get_unique_symtree (gfc_current_ns)
 		   : gfc_new_symtree (&gfc_current_ns->sym_root, p);
 
 	      st->ambiguous = ambiguous;
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 40e3435521e..3aae04c4923 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -2129,6 +2129,20 @@ gfc_find_symtree (gfc_symtree *st, const char *name)
 }
 
 
+/* Return a symtree node with a name that is guaranteed to be unique
+   within the namespace and corresponds to an illegal fortran name.  */
+
+gfc_symtree *
+gfc_get_unique_symtree (gfc_namespace *ns)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  static int serial = 0;
+
+  sprintf (name, "@%d", serial++);
+  return gfc_new_symtree (&ns->sym_root, name);
+}
+
+
 /* Given a name find a user operator node, creating it if it doesn't
    exist.  These are much simpler than symbols because they can't be
    ambiguous with one another.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d18f3b94d69..3dabc56d37c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,10 +1,9 @@
-2007-08-04  Thomas Koenig  <tkoenig@gcc.gnu.org>
+2007-08-04  Paul Thomas  <pault@gcc.gnu.org>
 
-	PR fortran/32770
-	* gfortran.dg/streamio_8.f90:  Adjust so test case passes
-	for -fdefault-integer-8 and -fdefault-real-8.
-	* gfortran.dg/streamio_10.f90:  Likewise.
-	* gfortran.dg/sizeof.f90:  Likewise.
+	PR fortran/31214
+	* gfortran.dg/entry_13.f90: New test.
+
+	* gfortran.dg/entry_12.f90: Clean up .mod file.
 
 2007-08-04  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
diff --git a/gcc/testsuite/gfortran.dg/entry_12.f90 b/gcc/testsuite/gfortran.dg/entry_12.f90
index 8793b42520e..5513697a17c 100644
--- a/gcc/testsuite/gfortran.dg/entry_12.f90
+++ b/gcc/testsuite/gfortran.dg/entry_12.f90
@@ -1,30 +1,31 @@
-! { dg-do run }

-! Tests the fix for pr31609, where module procedure entries found

-! themselves in the wrong namespace.  This test checks that all

-! combinations of generic and specific calls work correctly.

-!

-! Contributed by Paul Thomas <pault@gcc.gnu.org> as comment #8 to the pr.

-!

-MODULE ksbin1_aux_mod

-  interface foo

-    module procedure j

-  end interface

-  interface bar

-    module procedure k

-  end interface

-  interface foobar

-    module procedure j, k

-  end interface

-  CONTAINS

-    FUNCTION j () 

-    j = 1

-    return

-    ENTRY k (i) 

-    k = 2

-    END FUNCTION j

-END MODULE ksbin1_aux_mod

-

-    use ksbin1_aux_mod

-    if (any ((/foo (), bar (99), foobar (), foobar (99), j (), k (99)/) .ne. &

-             (/1, 2, 1, 2, 1, 2/))) Call abort ()

-end

+! { dg-do run }
+! Tests the fix for pr31609, where module procedure entries found
+! themselves in the wrong namespace.  This test checks that all
+! combinations of generic and specific calls work correctly.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org> as comment #8 to the pr.
+!
+MODULE ksbin1_aux_mod
+  interface foo
+    module procedure j
+  end interface
+  interface bar
+    module procedure k
+  end interface
+  interface foobar
+    module procedure j, k
+  end interface
+  CONTAINS
+    FUNCTION j () 
+    j = 1
+    return
+    ENTRY k (i) 
+    k = 2
+    END FUNCTION j
+END MODULE ksbin1_aux_mod
+
+    use ksbin1_aux_mod
+    if (any ((/foo (), bar (99), foobar (), foobar (99), j (), k (99)/) .ne. &
+             (/1, 2, 1, 2, 1, 2/))) Call abort ()
+end
+! { dg-final { cleanup-modules "ksbin1_aux_mod" } }
diff --git a/gcc/testsuite/gfortran.dg/entry_13.f90 b/gcc/testsuite/gfortran.dg/entry_13.f90
new file mode 100644
index 00000000000..2d2aedaf3d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_13.f90
@@ -0,0 +1,80 @@
+! { dg-do run }
+! Tests the fix for pr31214, in which the typespec for the entry would be lost,
+! thereby causing the function to be disallowed, since the function and entry
+! types did not match.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!
+module type_mod
+  implicit none
+
+  type x
+     real x
+  end type x
+  type y
+     real x
+  end type y
+  type z
+     real x
+  end type z
+
+  interface assignment(=)
+     module procedure equals
+  end interface assignment(=)
+
+  interface operator(//)
+     module procedure a_op_b, b_op_a
+  end interface operator(//)
+
+  interface operator(==)
+     module procedure a_po_b, b_po_a
+  end interface operator(==)
+
+  contains
+     subroutine equals(x,y)
+        type(z), intent(in) :: y
+        type(z), intent(out) :: x
+
+        x%x = y%x
+     end subroutine equals
+
+     function a_op_b(a,b)
+        type(x), intent(in) :: a
+        type(y), intent(in) :: b
+        type(z) a_op_b
+        type(z) b_op_a
+        a_op_b%x = a%x + b%x
+        return
+     entry b_op_a(b,a)
+        b_op_a%x = a%x - b%x
+     end function a_op_b
+
+     function a_po_b(a,b)
+        type(x), intent(in) :: a
+        type(y), intent(in) :: b
+        type(z) a_po_b
+        type(z) b_po_a
+     entry b_po_a(b,a)
+        a_po_b%x = a%x/b%x
+     end function a_po_b
+end module type_mod
+
+program test
+  use type_mod
+  implicit none
+  type(x) :: x1 = x(19.0_4)
+  type(y) :: y1 = y(7.0_4)
+  type(z) z1
+
+  z1 = x1//y1
+  if (z1%x .ne. 19.0_4 + 7.0_4) call abort ()
+  z1 = y1//x1
+  if (z1%x .ne. 19.0_4 - 7.0_4) call abort ()
+
+  z1 = x1==y1
+  if (z1%x .ne. 19.0_4/7.0_4) call abort ()
+  z1 = y1==x1
+  if (z1%x .ne. 19.0_4/7.0_4) call abort ()
+end program test
+! { dg-final { cleanup-modules "type_mod" } }
+