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] PR37583 - ICE "insert_bbt(): Duplicate key" for self-calling ENTRY subprogram


The attached patch fixes the problem and throws an error if the
subroutine is not recursive.

Bootstraps and regtests on x86_ia64/FC8 - OK for trunk (with a changelog)?

Paul

-- 
The knack of flying is learning how to throw yourself at the ground and miss.
 --Hitchhikers Guide to the Galaxy
Index: gcc/testsuite/gfortran.dg/entry_18.f90
===================================================================
*** gcc/testsuite/gfortran.dg/entry_18.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/entry_18.f90	(revision 0)
***************
*** 0 ****
--- 1,36 ----
+ ! { dg-do compile }
+ ! Test fix for PR37583, in which:
+ ! (i) the reference to glocal prior to the ENTRY caused an internal
+ ! error and
+ ! (ii) the need for a RECURSIVE attribute was ignored.
+ !
+ ! Contributed by Arjen Markus <arjen.markus@wldelft.nl>
+ !
+ module gsub
+ contains
+ recursive subroutine suba( g )   ! prefix with "RECURSIVE"
+    interface
+        real function g(x)
+        real x
+        end function
+    end interface
+    real :: x, y
+    call mysub( glocala )
+    return
+ entry glocala( x, y )
+    y = x
+ end subroutine
+ subroutine subb( g )
+    interface
+        real function g(x)
+        real x
+        end function
+    end interface
+    real :: x, y
+    call mysub( glocalb ) ! { dg-error "is recursive" }
+    return
+ entry glocalb( x, y )
+    y = x
+ end subroutine
+ end module
+ ! { dg-final { cleanup-modules "gsub" } }
Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c	(revision 140493)
--- gcc/fortran/decl.c	(working copy)
*************** gfc_match_entry (void)
*** 4640,4646 ****
    if (get_proc_name (name, &entry,
  		     gfc_current_ns->parent != NULL
  		     && module_procedure
! 		     && gfc_current_ns->proc_name->attr.function))
      return MATCH_ERROR;
  
    proc = gfc_current_block ();
--- 4640,4647 ----
    if (get_proc_name (name, &entry,
  		     gfc_current_ns->parent != NULL
  		     && module_procedure
! 		     && (gfc_current_ns->proc_name->attr.function
! 			   || gfc_current_ns->proc_name->attr.subroutine)))
      return MATCH_ERROR;
  
    proc = gfc_current_block ();
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 140493)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_actual_arglist (gfc_actual_argli
*** 1176,1181 ****
--- 1176,1190 ----
  	  /* Just in case a specific was found for the expression.  */
  	  sym = e->symtree->n.sym;
  
+ 	  if (sym->attr.entry && sym->ns->entries
+ 		&& sym->ns == gfc_current_ns
+ 		&& !sym->ns->entries->sym->attr.recursive)
+ 	    {
+ 	      gfc_error ("Reference to ENTRY '%s' at %L is recursive, but procedure "
+ 			 "'%s' is not declared as RECURSIVE",
+ 			 sym->name, &e->where, sym->ns->entries->sym->name);
+ 	    }
+ 
  	  /* If the symbol is the function that names the current (or
  	     parent) scope, then we really have a variable reference.  */
  

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