From 89aaa0cb9cf6b06e2fe97711508384dd5ca88e34 Mon Sep 17 00:00:00 2001 From: mikael Date: Tue, 8 Jan 2013 19:42:38 +0000 Subject: [PATCH] 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@195031 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 11 ++++ gcc/fortran/module.c | 13 ++++- gcc/fortran/resolve.c | 2 +- gcc/testsuite/ChangeLog | 11 ++++ gcc/testsuite/gfortran.dg/use_23.f90 | 42 ++++++++++++++ gcc/testsuite/gfortran.dg/use_24.f90 | 53 ++++++++++++++++++ gcc/testsuite/gfortran.dg/use_25.f90 | 39 +++++++++++++ gcc/testsuite/gfortran.dg/use_26.f90 | 76 ++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/use_27.f90 | 103 +++++++++++++++++++++++++++++++++++ 9 files changed, 346 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/use_23.f90 create mode 100644 gcc/testsuite/gfortran.dg/use_24.f90 create mode 100644 gcc/testsuite/gfortran.dg/use_25.f90 create mode 100644 gcc/testsuite/gfortran.dg/use_26.f90 create mode 100644 gcc/testsuite/gfortran.dg/use_27.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ffa137684d7..452e069ceb0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2013-01-08 Mikael Morin + + 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-07 Tobias Burnus Thomas Koenig Jakub Jelinek diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index e3631777fb4..f6662b47997 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -4641,8 +4641,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; } @@ -4663,7 +4669,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 { diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index bbc1c2208fb..18e94a13487 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -3636,7 +3636,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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1f9bccff04d..58a7e904e11 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,14 @@ +2013-01-08 Mikael Morin + + 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-07 Tobias Burnus PR fortran/55852 diff --git a/gcc/testsuite/gfortran.dg/use_23.f90 b/gcc/testsuite/gfortran.dg/use_23.f90 new file mode 100644 index 00000000000..da05e1a8e20 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/use_23.f90 @@ -0,0 +1,42 @@ +! { 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 +! Reduced by Janus Weil + +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 + + + diff --git a/gcc/testsuite/gfortran.dg/use_24.f90 b/gcc/testsuite/gfortran.dg/use_24.f90 new file mode 100644 index 00000000000..b709347b0fd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/use_24.f90 @@ -0,0 +1,53 @@ +! { 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 +! Reduced by Janus Weil + +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 + + + diff --git a/gcc/testsuite/gfortran.dg/use_25.f90 b/gcc/testsuite/gfortran.dg/use_25.f90 new file mode 100644 index 00000000000..b79297f9fce --- /dev/null +++ b/gcc/testsuite/gfortran.dg/use_25.f90 @@ -0,0 +1,39 @@ +! { 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 +! Reduced by Janus Weil + +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 + + diff --git a/gcc/testsuite/gfortran.dg/use_26.f90 b/gcc/testsuite/gfortran.dg/use_26.f90 new file mode 100644 index 00000000000..2e66401a14c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/use_26.f90 @@ -0,0 +1,76 @@ +! { 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 + +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 + + diff --git a/gcc/testsuite/gfortran.dg/use_27.f90 b/gcc/testsuite/gfortran.dg/use_27.f90 new file mode 100644 index 00000000000..71d77cc0180 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/use_27.f90 @@ -0,0 +1,103 @@ +! { 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 + +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 + + -- 2.11.0