diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2009-10-09 22:25:19 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2009-10-09 22:25:19 +0200 |
| commit | 7431bf06bc2bb01a307a796bf4de57d9ca48bb38 (patch) | |
| tree | 4469b291b15c4ee960294436b60b6b3e388e3d3c /gcc/fortran/symbol.c | |
| parent | 21ece9b288130746b5b772a7b18b50ef7a8bc706 (diff) | |
| download | gcc-7431bf06bc2bb01a307a796bf4de57d9ca48bb38.zip gcc-7431bf06bc2bb01a307a796bf4de57d9ca48bb38.tar.gz gcc-7431bf06bc2bb01a307a796bf4de57d9ca48bb38.tar.bz2 | |
re PR fortran/41579 ([OOP] Nesting of SELECT TYPE)
2009-10-09 Janus Weil <janus@gcc.gnu.org>
PR fortran/41579
* gfortran.h (gfc_select_type_stack): New struct, to be used as a stack
for SELECT TYPE statements.
(select_type_stack): New global variable.
(type_selector,select_type_tmp): Removed.
* match.c (type_selector,type_selector): Removed.
(select_type_stack): New variable, serving as a stack for
SELECT TYPE statements.
(select_type_push,select_type_set_tmp): New functions.
(gfc_match_select_type): Call select_type_push.
(gfc_match_type_is): Call select_type_set_tmp.
* parse.c (select_type_pop): New function.
(parse_select_type_block): Call select_type_pop.
* symbol.c (select_type_insert_tmp): New function.
(gfc_find_sym_tree): Call select_type_insert_tmp.
2009-10-09 Janus Weil <janus@gcc.gnu.org>
PR fortran/41579
* gfortran.dg/select_type_6.f03: New test.
From-SVN: r152600
Diffstat (limited to 'gcc/fortran/symbol.c')
| -rw-r--r-- | gcc/fortran/symbol.c | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index befa90b..2641df8 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -2461,6 +2461,19 @@ ambiguous_symbol (const char *name, gfc_symtree *st) } +/* If we're in a SELECT TYPE block, check if the variable 'st' matches any + selector on the stack. If yes, replace it by the corresponding temporary. */ + +static void +select_type_insert_tmp (gfc_symtree **st) +{ + gfc_select_type_stack *stack = select_type_stack; + for (; stack; stack = stack->prev) + if ((*st)->n.sym == stack->selector) + *st = stack->tmp; +} + + /* Search for a symtree starting in the current namespace, resorting to any parent namespaces if requested by a nonzero parent_flag. Returns nonzero if the name is ambiguous. */ @@ -2479,11 +2492,7 @@ gfc_find_sym_tree (const char *name, gfc_namespace *ns, int parent_flag, st = gfc_find_symtree (ns->sym_root, name); if (st != NULL) { - /* Special case: If we're in a SELECT TYPE block, - replace the selector variable by a temporary. */ - if (gfc_current_state () == COMP_SELECT_TYPE - && st && st->n.sym == type_selector) - st = select_type_tmp; + select_type_insert_tmp (&st); *result = st; /* Ambiguous generic interfaces are permitted, as long |