[Patch, Fortran] PR 41781: [OOP] bogus undefined label error with SELECT TYPE

[Janus Weil <janus at gcc dot gnu dot org>]

Hi all,

here is my patch for this PR, which is about problems with GOTOs
jumping in and out of BLOCK constructs (and SELECT TYPE). BLOCK
constructs have their own local namespace, and the problem was
basically that the label was stored in the wrong namespace.

Regtested on x86_64-unknown-linux-gnu. Ok for trunk?

Cheers,
Janus


2009-10-21  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41781
	* resolve.c (resolve_codes): Don't clear 'cs_base' for BLOCK constructs,
	to make sure labels are treated correctly.
	* symbol.c (gfc_get_st_label): Create labels in the right namespace.
	For BLOCK constructs go into the parent namespace.


2009-10-21  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41781
	* gfortran.dg/goto_8.f90: New test case.

Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(Revision 153063)
+++ gcc/fortran/symbol.c	(Arbeitskopie)
@@ -2030,9 +2030,16 @@ gfc_st_label *
 gfc_get_st_label (int labelno)
 {
   gfc_st_label *lp;
+  gfc_namespace *ns;
 
+  /* Find the namespace of the scoping unit:
+     If we're in a BLOCK construct, jump to the parent namespace.  */
+  ns = gfc_current_ns;
+  while (ns->proc_name && ns->proc_name->attr.flavor == FL_LABEL)
+    ns = ns->parent;
+
   /* First see if the label is already in this namespace.  */
-  lp = gfc_current_ns->st_labels;
+  lp = ns->st_labels;
   while (lp)
     {
       if (lp->value == labelno)
@@ -2050,7 +2057,7 @@ gfc_get_st_label (int labelno)
   lp->defined = ST_LABEL_UNKNOWN;
   lp->referenced = ST_LABEL_UNKNOWN;
 
-  gfc_insert_bbt (&gfc_current_ns->st_labels, lp, compare_st_labels);
+  gfc_insert_bbt (&ns->st_labels, lp, compare_st_labels);
 
   return lp;
 }
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 153063)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -12053,7 +12053,11 @@ resolve_codes (gfc_namespace *ns)
     resolve_codes (n);
 
   gfc_current_ns = ns;
-  cs_base = NULL;
+
+  /* Don't clear 'cs_base' if this is the namespace of a BLOCK construct.  */
+  if (!(ns->proc_name && ns->proc_name->attr.flavor == FL_LABEL))
+    cs_base = NULL;
+
   /* Set to an out of range value.  */
   current_entry_id = -1;

Attachment: goto_8.f90
Description: Binary data