From 21bdb87e1ce8fd7e8c8b31290bfadd66869a686e Mon Sep 17 00:00:00 2001 From: pault Date: Thu, 14 Jan 2010 06:13:19 +0000 Subject: [PATCH] 2010-01-14 Paul Thomas PR fortran/42481 * module.c (load_generic_interfaces): If a procedure that is use associated but not generic is given an interface that includes itself, then make it generic. 2010-01-14 Paul Thomas PR fortran/42481 * gfortran.dg/generic_19.f90 : New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@155876 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 ++++++ gcc/fortran/module.c | 32 ++++++++++++++++++++++++--- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/generic_19.f90 | 37 ++++++++++++++++++++++++++++++++ 4 files changed, 78 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/generic_19.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 09bfccfe003..be65b9ab58e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2010-01-14 Paul Thomas + + PR fortran/42481 + * module.c (load_generic_interfaces): If a procedure that is + use associated but not generic is given an interface that + includes itself, then make it generic. + 2010-01-11 Joseph Myers Shujing Zhao diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 140f2e2d574..667bab83c49 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -1,6 +1,7 @@ /* Handle modules, which amounts to loading and saving symbols and their attendant structures. - Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 + Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, + 2009, 2010 Free Software Foundation, Inc. Contributed by Andy Vaught @@ -3750,8 +3751,9 @@ load_generic_interfaces (void) const char *p; char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1]; gfc_symbol *sym; - gfc_interface *generic = NULL; + gfc_interface *generic = NULL, *gen = NULL; int n, i, renamed; + bool ambiguous_set = false; mio_lparen (); @@ -3836,9 +3838,13 @@ load_generic_interfaces (void) sym = st->n.sym; if (st && !sym->attr.generic + && !st->ambiguous && sym->module && strcmp(module, sym->module)) - st->ambiguous = 1; + { + ambiguous_set = true; + st->ambiguous = 1; + } } sym->attr.use_only = only_flag; @@ -3854,6 +3860,26 @@ load_generic_interfaces (void) sym->generic = generic; sym->attr.generic_copy = 1; } + + /* If a procedure that is not generic has generic interfaces + that include itself, it is generic! We need to take care + to retain symbols ambiguous that were already so. */ + if (sym->attr.use_assoc + && !sym->attr.generic + && sym->attr.flavor == FL_PROCEDURE) + { + for (gen = generic; gen; gen = gen->next) + { + if (gen->sym == sym) + { + sym->attr.generic = 1; + if (ambiguous_set) + st->ambiguous = 0; + break; + } + } + } + } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6484dd8c618..2195d2e35ea 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-01-14 Paul Thomas + + PR fortran/42481 + * gfortran.dg/generic_19.f90 : New test. + 2010-01-13 Richard Guenther PR tree-optimization/42730 diff --git a/gcc/testsuite/gfortran.dg/generic_19.f90 b/gcc/testsuite/gfortran.dg/generic_19.f90 new file mode 100644 index 00000000000..f023c5e6356 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/generic_19.f90 @@ -0,0 +1,37 @@ +! { dg-do compile } +! Test the fix for PR42481, in which 'sub' was not recognised as +! a generic interface. +! +! Contributed by William Mitchell < william.mitchell@nist.gov> +! +module mod1 +contains + subroutine sub(x, chr) + real x + character(8) chr + if (trim (chr) .ne. "real") call abort + if (int (x) .ne. 1) call abort + end subroutine sub +end module mod1 + +module mod2 + use mod1 + interface sub + module procedure sub, sub_int + end interface sub +contains + subroutine sub_int(i, chr) + character(8) chr + integer i + if (trim (chr) .ne. "integer") call abort + if (i .ne. 1) call abort + end subroutine sub_int +end module mod2 + +program prog + use mod1 + use mod2 + call sub(1, "integer ") + call sub(1.0, "real ") +end program prog +! { dg-final { cleanup-modules "mod1 mod2" } } -- 2.11.4.GIT