This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, fortran] PR42481 - generic interface not recognized


This is very straightforward, verging on obvious.  I think that it is
sufficient to compile the testcase but it would run too.

Regtested and bootstrapped on FC9/x86_64 - OK for trunk?

Cheers

Paul

2010-01-13  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-13  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/42481
	* gfortran.dg/generic_19.f90 : New test.
Index: gcc/fortran/module.c
===================================================================
*** gcc/fortran/module.c	(revision 155768)
--- gcc/fortran/module.c	(working copy)
*************** load_generic_interfaces (void)
*** 3750,3757 ****
    const char *p;
    char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1];
    gfc_symbol *sym;
!   gfc_interface *generic = NULL;
    int n, i, renamed;
  
    mio_lparen ();
  
--- 3750,3758 ----
    const char *p;
    char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1];
    gfc_symbol *sym;
!   gfc_interface *generic = NULL, *gen = NULL;
    int n, i, renamed;
+   bool ambiguous_set = false;
  
    mio_lparen ();
  
*************** load_generic_interfaces (void)
*** 3836,3844 ****
  	      sym = st->n.sym;
  
  	      if (st && !sym->attr.generic
  		     && sym->module
  		     && strcmp(module, sym->module))
! 		st->ambiguous = 1;
  	    }
  
  	  sym->attr.use_only = only_flag;
--- 3837,3849 ----
  	      sym = st->n.sym;
  
  	      if (st && !sym->attr.generic
+ 		     && !st->ambiguous
  		     && sym->module
  		     && strcmp(module, sym->module))
! 		{
! 		  ambiguous_set = true;
! 		  st->ambiguous = 1;
! 		}
  	    }
  
  	  sym->attr.use_only = only_flag;
*************** load_generic_interfaces (void)
*** 3854,3859 ****
--- 3859,3884 ----
  	      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;
+ 		    }
+ 		}
+ 	    }
+ 
  	}
      }
  
Index: gcc/testsuite/gfortran.dg/generic_19.f90
===================================================================
*** gcc/testsuite/gfortran.dg/generic_19.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/generic_19.f90	(revision 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" } }

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]