re PR fortran/41781 ([OOP] bogus undefined label error with SELECT TYPE.)

2009-10-22  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-22  Janus Weil  <janus@gcc.gnu.org>

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

From-SVN: r153446

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b3567e4cff79f4ef425200ea88921da160f1d473..6a440800fa0a94f3af2507f96924331c1cb45ae8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2009-10-22  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/41706

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8e23308d5b248cedd6b16ac3c65df04b8ad027fa..4c10a0cc1d69aedb3d9c03ac9c388fdecc5a2816 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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;
 

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 837a357d9fb17c35ebb507167a1ec40b5f308b00..c1b39b0d9f1efc2ea491111c400d629e41d4d9ee 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -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;
 }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d8b50b7b18d04bd86b4c0194592df86fb413387e..42ca4b2cdd7da73fde89b5ad1217a1a28a404c90 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-10-22  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/41781
+       * gfortran.dg/goto_8.f90: New test case.
+
 2009-10-21  Sebastian Pop  <sebastian.pop@amd.com>
 
        PR tree-optimization/41497

diff --git a/gcc/testsuite/gfortran.dg/goto_8.f90 b/gcc/testsuite/gfortran.dg/goto_8.f90
new file mode 100644 (file)
index 0000000..a5f1f7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goto_8.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+!
+! PR 41781: [OOP] bogus undefined label error with SELECT TYPE.
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+! and Tobias Burnus >burnus@gcc.gnu.org>
+
+! 1st example: jumping out of SELECT TYPE (valid)
+type bar
+  integer :: i
+end type bar
+class(bar), pointer :: var
+select type(var)
+class default
+  goto 9999
+end select
+9999 continue
+
+! 2nd example: jumping out of BLOCK (valid) 
+block
+  goto 88
+end block
+88 continue
+
+! 3rd example: jumping into BLOCK (invalid)
+goto 99        ! { dg-error "is not in the same block" }
+block
+  99 continue  ! { dg-error "is not in the same block" }
+end block
+
+end