re PR fortran/42769 ([OOP] ICE in resolve_typebound_procedure)

	PR fortran/42769
	PR fortran/45836
	PR fortran/45900
	* module.c (read_module): Don't reuse local symtree if the associated
	symbol isn't exactly the one wanted.  Don't reuse local symtree if it is
	ambiguous.
	* resolve.c (resolve_call): Use symtree's name instead of symbol's to
	lookup the symtree.

	PR fortran/42769
	PR fortran/45836
	PR fortran/45900
	* gfortran.dg/use_23.f90: New test.
	* gfortran.dg/use_24.f90: New test.
	* gfortran.dg/use_25.f90: New test.
	* gfortran.dg/use_26.f90: New test.
	* gfortran.dg/use_27.f90: New test.

From-SVN: r194949

gcc/fortran/ChangeLog

+2013-01-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/42769
+	PR fortran/45836
+	PR fortran/45900
+	* module.c (read_module): Don't reuse local symtree if the associated
+	symbol isn't exactly the one wanted.  Don't reuse local symtree if it is
+	ambiguous.
+	* resolve.c (resolve_call): Use symtree's name instead of symbol's to
+	lookup the symtree.
+
 2013-01-05  Steven G. Kargl  <kargl@gcc.gnu.org>
 	    Mikael Morin  <mikael@gcc.gnu.org>
 

gcc/fortran/module.c

@@ -4663,8 +4663,14 @@ read_module (void)
 	  if (p == NULL)
 	    {
 	      st = gfc_find_symtree (gfc_current_ns->sym_root, name);
-	      if (st != NULL)
-		info->u.rsym.symtree = st;
+	      if (st != NULL
+		  && strcmp (st->n.sym->name, info->u.rsym.true_name) == 0
+		  && st->n.sym->module != NULL
+		  && strcmp (st->n.sym->module, info->u.rsym.module) == 0)
+		{
+		  info->u.rsym.symtree = st;
+		  info->u.rsym.sym = st->n.sym;
+		}
 	      continue;
 	    }
 
@@ -4685,7 +4691,8 @@ read_module (void)
 	      /* Check for ambiguous symbols.  */
 	      if (check_for_ambiguous (st->n.sym, info))
 		st->ambiguous = 1;
-	      info->u.rsym.symtree = st;
+	      else
+		info->u.rsym.symtree = st;
 	    }
 	  else
 	    {

gcc/fortran/resolve.c

@@ -3776,7 +3776,7 @@ resolve_call (gfc_code *c)
   if (csym && gfc_current_ns->parent && csym->ns != gfc_current_ns)
     {
       gfc_symtree *st;
-      gfc_find_sym_tree (csym->name, gfc_current_ns, 1, &st);
+      gfc_find_sym_tree (c->symtree->name, gfc_current_ns, 1, &st);
       sym = st ? st->n.sym : NULL;
       if (sym && csym != sym
 	      && sym->ns == gfc_current_ns

gcc/testsuite/ChangeLog

+2013-01-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/42769
+	PR fortran/45836
+	PR fortran/45900
+	* gfortran.dg/use_23.f90: New test.
+	* gfortran.dg/use_24.f90: New test.
+	* gfortran.dg/use_25.f90: New test.
+	* gfortran.dg/use_26.f90: New test.
+	* gfortran.dg/use_27.f90: New test.
+
 2013-01-06  Olivier Hainque  <hainque@adacore.com>
 
 	* gnat.dg/specs/clause_on_volatile.ads: New test.

gcc/testsuite/gfortran.dg/use_23.f90

+! { dg-do compile }
+!
+! PR fortran/42769
+! This test used to ICE in resolve_typebound_procedure because T1's GET
+! procedure was wrongly associated to MOD2's MY_GET (instead of the original
+! MOD1's MY_GET) in MOD3's SUB.
+!
+! Original testcase by Salvator Filippone <sfilippone@uniroma2.it>
+! Reduced by Janus Weil <janus@gcc.gnu.org>
+
+module mod1
+  type :: t1
+  contains
+    procedure, nopass :: get => my_get
+  end type
+contains 
+  logical function my_get()
+  end function
+end module
+
+module mod2
+contains 
+  logical function my_get()
+  end function
+end module
+
+module mod3
+contains
+  subroutine sub(a)
+    use mod2, only: my_get
+    use mod1, only: t1
+    type(t1) :: a
+  end subroutine
+end module
+
+
+use mod2, only: my_get
+use mod3, only: sub
+end 
+
+
+

gcc/testsuite/gfortran.dg/use_24.f90

+! { dg-do run }
+!
+! PR fortran/42769
+! The static resolution of A%GET used to be incorrectly simplified to MOD2's
+! MY_GET instead of the original MOD1's MY_GET, depending on the order in which
+! MOD1 and MOD2 were use-associated.
+!
+! Original testcase by Salvator Filippone <sfilippone@uniroma2.it>
+! Reduced by Janus Weil <janus@gcc.gnu.org>
+
+module mod1
+  type :: t1
+  contains
+    procedure, nopass :: get => my_get
+  end type
+contains 
+  subroutine my_get(i)
+    i = 2
+  end subroutine
+end module
+
+module mod2
+contains 
+  subroutine my_get(i)    ! must have the same name as the function in mod1
+    i = 5
+  end subroutine
+end module
+
+
+ call test1()
+ call test2()
+
+contains
+
+ subroutine test1()
+  use mod2
+  use mod1
+  type(t1) :: a
+  call a%get(j)
+  if (j /= 2) call abort
+ end subroutine test1
+
+ subroutine test2()
+  use mod1
+  use mod2
+  type(t1) :: a
+  call a%get(j)
+  if (j /= 2) call abort
+ end subroutine test2
+end
+
+
+

gcc/testsuite/gfortran.dg/use_25.f90

+! { dg-do compile }
+!
+! PR fortran/42769
+! This test used to be rejected because the typebound call A%GET was
+! simplified to MY_GET which is an ambiguous name in the main program
+! namespace.
+!
+! Original testcase by Salvator Filippone <sfilippone@uniroma2.it>
+! Reduced by Janus Weil <janus@gcc.gnu.org>
+
+module mod1
+  type :: t1
+  contains
+    procedure, nopass :: get => my_get
+  end type
+contains 
+  subroutine my_get()
+    print *,"my_get (mod1)"
+  end subroutine
+end module
+
+module mod2
+contains 
+  subroutine my_get()    ! must have the same name as the function in mod1
+    print *,"my_get (mod2)"
+  end subroutine
+end module
+
+  use mod2
+  use mod1
+  type(t1) :: a
+  call call_get
+  contains
+  subroutine call_get
+    call a%get()
+  end subroutine call_get
+end
+
+

gcc/testsuite/gfortran.dg/use_26.f90

+! { dg-do compile }
+!
+! PR fortran/45836
+! The B_TYPE_INSTANCE%SIZERETURN() typebound function used to be rejected on a
+! type mismatch because the function was resolved to A's SIZERETURN instead of
+! B's because of the ambiguity of the SIZERETURN name in the MAIN namespace.
+!
+! Original testcase by someone <ortp21@gmail.com>
+
+module A
+implicit none
+    type :: a_type
+    private
+        integer :: size = 1
+    contains
+        procedure :: sizeReturn
+    end type a_type
+    contains
+        function sizeReturn( a_type_ )
+            implicit none
+            integer :: sizeReturn
+            class(a_type) :: a_type_
+
+            sizeReturn = a_type_%size
+        end function sizeReturn
+end module A
+
+module B
+implicit none
+    type :: b_type
+    private
+        integer :: size = 2
+    contains
+        procedure :: sizeReturn
+    end type b_type
+    contains
+        function sizeReturn( b_type_ )
+            implicit none
+            integer :: sizeReturn
+            class(b_type) :: b_type_
+
+            sizeReturn = b_type_%size
+        end function sizeReturn
+end module B
+
+program main
+
+  call test1
+  call test2
+
+contains
+
+  subroutine test1
+    use A
+    use B
+    implicit none
+    type(a_type) :: a_type_instance
+    type(b_type) :: b_type_instance
+
+    print *, a_type_instance%sizeReturn()
+    print *, b_type_instance%sizeReturn()
+  end subroutine test1
+
+  subroutine test2
+    use B
+    use A
+    implicit none
+    type(a_type) :: a_type_instance
+    type(b_type) :: b_type_instance
+
+    print *, a_type_instance%sizeReturn()
+    print *, b_type_instance%sizeReturn()
+  end subroutine test2
+end program main
+
+

gcc/testsuite/gfortran.dg/use_27.f90

+! { dg-do run }
+!
+! PR fortran/45900
+! The BTYPEINSTANCE%CALLBACK() typebound call was resolved incorrectly to
+! A's CALLBACK procedure instead of B's because the CALLBACK name is ambiguous
+! in the MAIN namespace.
+!
+! Original testcase by someone <ortp21@gmail.com>
+
+module A
+implicit none
+    type :: aType
+    contains
+        procedure :: callback
+    end type aType
+    contains
+        subroutine callback( callback_, i )
+            implicit none
+            class(aType) :: callback_
+            integer :: i
+
+            i = 3
+        end subroutine callback
+
+        subroutine solver( callback_, i )
+            implicit none
+            class(aType) :: callback_
+            integer :: i
+
+            call callback_%callback(i)
+        end subroutine solver
+end module A
+
+module B
+use A, only: aType
+implicit none
+    type, extends(aType) :: bType
+        integer :: i
+    contains
+        procedure :: callback
+    end type bType
+    contains
+        subroutine callback( callback_, i )
+            implicit none
+            class(bType) :: callback_
+            integer :: i
+
+            i = 7
+        end subroutine callback
+end module B
+
+program main
+  call test1()
+  call test2()
+
+contains
+
+  subroutine test1
+    use A
+    use B
+    implicit none
+    type(aType) :: aTypeInstance
+    type(bType) :: bTypeInstance
+    integer :: iflag
+
+    bTypeInstance%i = 4
+
+    iflag = 0
+    call bTypeInstance%callback(iflag)
+    if (iflag /= 7) call abort
+    iflag = 1
+    call solver( bTypeInstance, iflag )
+    if (iflag /= 7) call abort
+
+    iflag = 2
+    call aTypeInstance%callback(iflag)
+    if (iflag /= 3) call abort
+  end subroutine test1
+
+  subroutine test2
+    use B
+    use A
+    implicit none
+    type(aType) :: aTypeInstance
+    type(bType) :: bTypeInstance
+    integer :: iflag
+
+    bTypeInstance%i = 4
+
+    iflag = 0
+    call bTypeInstance%callback(iflag)
+    if (iflag /= 7) call abort
+    iflag = 1
+    call solver( bTypeInstance, iflag )
+    if (iflag /= 7) call abort
+
+    iflag = 2
+    call aTypeInstance%callback(iflag)
+    if (iflag /= 3) call abort
+  end subroutine test2
+end program main
+
+