diff options
author | Janus Weil <janus@gcc.gnu.org> | 2009-10-22 08:53:26 +0000 |
---|---|---|
committer | Janus Weil <janus@gcc.gnu.org> | 2009-10-22 08:53:26 +0000 |
commit | afd74094f627ed867b5266bd99b3350f7f416513 (patch) | |
tree | 74a64b748e313ef72c5dd3cece6e6507c616170e | |
parent | 46ffbfdca48aeb09800392998ee05d502994cb6f (diff) |
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.
git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@153446 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 6 | ||||
-rw-r--r-- | gcc/fortran/symbol.c | 11 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/goto_8.f90 | 31 |
5 files changed, 58 insertions, 3 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b3567e4cff7..6a440800fa0 100644 --- 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 8e23308d5b2..4c10a0cc1d6 100644 --- 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 837a357d9fb..c1b39b0d9f1 100644 --- 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 d8b50b7b18d..42ca4b2cdd7 100644 --- 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 index 00000000000..a5f1f7f07b9 --- /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 |