re PR fortran/42481 (generic interface not recognized)

2010-01-14  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	PR fortran/42481
	* gfortran.dg/generic_19.f90 : New test.

From-SVN: r155876

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 09bfccfe003630197717b3e522fcb48948e1c642..be65b9ab58e4a848045ee1ac421995d9dcf291b7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2010-01-14  Paul Thomas  <pault@gcc.gnu.org>
+
+       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  <joseph@codesourcery.com>  
            Shujing Zhao  <pearly.zhao@oracle.com>
 

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 140f2e2d5745d5c1be93fae92e2d4d8742c39fa8..667bab83c49712f29ec8058aeab0a61df6a75028 100644 (file)
--- 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 6484dd8c6183c5636c11599352017467b0737830..2195d2e35ea7778d44bb57342c242717261a117e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-01-14  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/42481
+       * gfortran.dg/generic_19.f90 : New test.
+
 2010-01-13  Richard Guenther  <rguenther@suse.de>
 
        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 (file)
index 0000000..f023c5e
--- /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" } }