From 93d7668704bbd18bfdc52deddb247e9412a20d85 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Wed, 7 Oct 2009 12:54:35 +0200 Subject: expr.c (gfc_check_pointer_assign): Do the correct type checking when CLASS variables are involved. 2009-10-07 Janus Weil * expr.c (gfc_check_pointer_assign): Do the correct type checking when CLASS variables are involved. * match.c (gfc_match_select_type): Parse associate-name in SELECT TYPE statements, and set up a local namespace for the SELECT TYPE block. * parse.h (gfc_build_block_ns): New prototype. * parse.c (parse_select_type_block): Return from local namespace to its parent after SELECT TYPE block. (gfc_build_block_ns): New function for setting up the local namespace for a BLOCK construct. (parse_block_construct): Use gfc_build_block_ns. * resolve.c (resolve_select_type): Insert assignment for the selector variable, in case an associate-name is given, and put the SELECT TYPE statement inside a BLOCK. (resolve_code): Call resolve_class_assign after checking the assignment. * symbol.c (gfc_find_sym_tree): Moved some code here from gfc_get_ha_sym_tree. (gfc_get_ha_sym_tree): Moved some code to gfc_find_sym_tree. 2009-10-07 Janus Weil * gfortran.dg/same_type_as_2.f03: Modified (was illegal). * gfortran.dg/select_type_1.f03: Modified error message. * gfortran.dg/select_type_5.f03: New test. From-SVN: r152526 --- gcc/fortran/parse.c | 39 ++++++++++++++++++++++++--------------- 1 file changed, 24 insertions(+), 15 deletions(-) (limited to 'gcc/fortran/parse.c') diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 13199c9..770c7ef 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2909,12 +2909,8 @@ parse_select_type_block (void) if (st == ST_NONE) unexpected_eof (); if (st == ST_END_SELECT) - { - /* Empty SELECT CASE is OK. */ - accept_statement (st); - pop_state (); - return; - } + /* Empty SELECT CASE is OK. */ + goto done; if (st == ST_TYPE_IS || st == ST_CLASS_IS) break; @@ -2959,8 +2955,10 @@ parse_select_type_block (void) } while (st != ST_END_SELECT); +done: pop_state (); accept_statement (st); + gfc_current_ns = gfc_current_ns->parent; } @@ -3033,18 +3031,13 @@ check_do_closure (void) static void parse_progunit (gfc_statement); -/* Parse a BLOCK construct. */ +/* Set up the local namespace for a BLOCK construct. */ -static void -parse_block_construct (void) +gfc_namespace* +gfc_build_block_ns (gfc_namespace *parent_ns) { - gfc_namespace* parent_ns; gfc_namespace* my_ns; - gfc_state_data s; - gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BLOCK construct at %C"); - - parent_ns = gfc_current_ns; my_ns = gfc_get_namespace (parent_ns, 1); my_ns->construct_entities = 1; @@ -3066,6 +3059,22 @@ parse_block_construct (void) } my_ns->proc_name->attr.recursive = parent_ns->proc_name->attr.recursive; + return my_ns; +} + + +/* Parse a BLOCK construct. */ + +static void +parse_block_construct (void) +{ + gfc_namespace* my_ns; + gfc_state_data s; + + gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BLOCK construct at %C"); + + my_ns = gfc_build_block_ns (gfc_current_ns); + new_st.op = EXEC_BLOCK; new_st.ext.ns = my_ns; accept_statement (ST_BLOCK); @@ -3075,7 +3084,7 @@ parse_block_construct (void) parse_progunit (ST_NONE); - gfc_current_ns = parent_ns; + gfc_current_ns = gfc_current_ns->parent; pop_state (); } -- cgit v1.1