This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran 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] PR32926 - ICE with external function as argument


:ADDPATCH fortran:

This is one of the F95 threatening bugs - it's got to go!

In fact the ChangeLogs and the patch are between them self-explanatory and teh testcase is based on the reporter's.

Regtested on amd64/Cygwin_NT - OK for trunk?

Paul

2007-08-14 Paul Thomas <pault@gcc.gnu.org>

   PR fortran/32926
   * match.c (gfc_match_call): Do not create a new symtree in the
   case where the existing symbol is external and not referenced.

2007-08-14 Paul Thomas <pault@gcc.gnu.org>

   PR fortran/32926
   * gfortran.dg/external_procedures_3.f90: New test.


Index: gcc/fortran/match.c
===================================================================
*** gcc/fortran/match.c	(revision 127390)
--- gcc/fortran/match.c	(working copy)
*************** gfc_match_call (void)
*** 2333,2345 ****
    if (!sym->attr.generic
  	&& !sym->attr.subroutine)
      {
!       /* ...create a symbol in this scope...  */
!       if (sym->ns != gfc_current_ns
! 	    && gfc_get_sym_tree (name, NULL, &st) == 1)
!         return MATCH_ERROR;
  
!       if (sym != st->n.sym)
! 	sym = st->n.sym;
  
        /* ...and then to try to make the symbol into a subroutine.  */
        if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
--- 2333,2348 ----
    if (!sym->attr.generic
  	&& !sym->attr.subroutine)
      {
!       if (!(sym->attr.external && !sym->attr.referenced))
! 	{
! 	  /* ...create a symbol in this scope...  */
! 	  if (sym->ns != gfc_current_ns
! 	        && gfc_get_sym_tree (name, NULL, &st) == 1)
!             return MATCH_ERROR;
  
! 	  if (sym != st->n.sym)
! 	    sym = st->n.sym;
! 	}
  
        /* ...and then to try to make the symbol into a subroutine.  */
        if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
Index: gcc/testsuite/gfortran.dg/external_procedures_3.f90
===================================================================
*** gcc/testsuite/gfortran.dg/external_procedures_3.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/external_procedures_3.f90	(revision 0)
***************
*** 0 ****
--- 1,35 ----
+ ! { dg-do run }
+ ! Tests the fix for PR32926, in which the call to fcn
+ ! in bar would cause an ICE because it had not been referenced
+ ! in the namespace where it was declared.
+ !
+ ! Contributed by Ralph Baker Kearfott <rbk@louisiana.edu>
+ !
+ subroutine foobar1
+   common // chr
+   character(8) :: chr
+   chr = "foobar1"
+ end subroutine
+ subroutine foobar2
+   common // chr
+   character(8) :: chr
+   chr = "foobar2"
+ end subroutine
+ 
+ subroutine foo (fcn)
+   external fcn
+   call bar
+ contains
+   subroutine bar
+     call fcn
+   end subroutine bar
+ end subroutine foo
+ 
+   external foo, foobar1, foobar2
+   common // chr
+   character(8) :: chr
+   call foo (foobar1)
+   if (chr .ne. "foobar1") call abort ()
+   call foo (foobar2)
+   if (chr .ne. "foobar2") call abort ()
+ end

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