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

2 files changed, 111 insertions, 30 deletions

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" } }
+