+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
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;
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)
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;
}
+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
--- /dev/null
+! { 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