OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Janus Weil 2009-10-22 10:53:26 +02:00
parent 7e1e7d4cc6
commit 76d02e9fa7
5 changed files with 58 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -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

6
gcc/fortran/resolve.c
View File

@ -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;

11
gcc/fortran/symbol.c
View File

@ -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;
}

5
gcc/testsuite/ChangeLog
View File

@ -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

31
gcc/testsuite/gfortran.dg/goto_8.f90 Normal file
View File

@ -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