diff options
Diffstat (limited to 'gcc/fortran/parse.c')
| -rw-r--r-- | gcc/fortran/parse.c | 109 |
1 files changed, 98 insertions, 11 deletions
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 93a6cfd..e6b5dbb 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -289,7 +289,7 @@ decode_statement (void) gfc_undo_symbols (); gfc_current_locus = old_locus; - /* Check for the IF, DO, SELECT, WHERE and FORALL statements, which + /* Check for the IF, DO, SELECT, WHERE, FORALL and BLOCK statements, which might begin with a block label. The match functions for these statements are unusual in that their keyword is not seen before the matcher is called. */ @@ -309,6 +309,7 @@ decode_statement (void) gfc_undo_symbols (); gfc_current_locus = old_locus; + match (NULL, gfc_match_block, ST_BLOCK); match (NULL, gfc_match_do, ST_DO); match (NULL, gfc_match_select, ST_SELECT_CASE); @@ -933,7 +934,8 @@ next_statement (void) /* Statements that mark other executable statements. */ -#define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: case ST_IF_BLOCK: \ +#define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: \ + case ST_IF_BLOCK: case ST_BLOCK: \ case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_OMP_PARALLEL: \ case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \ case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \ @@ -952,7 +954,8 @@ next_statement (void) are detected in gfc_match_end(). */ #define case_end case ST_END_BLOCK_DATA: case ST_END_FUNCTION: \ - case ST_END_PROGRAM: case ST_END_SUBROUTINE + case ST_END_PROGRAM: case ST_END_SUBROUTINE: \ + case ST_END_BLOCK /* Push a new state onto the stack. */ @@ -1142,6 +1145,9 @@ gfc_ascii_statement (gfc_statement st) case ST_BACKSPACE: p = "BACKSPACE"; break; + case ST_BLOCK: + p = "BLOCK"; + break; case ST_BLOCK_DATA: p = "BLOCK DATA"; break; @@ -1190,6 +1196,9 @@ gfc_ascii_statement (gfc_statement st) case ST_ELSEWHERE: p = "ELSEWHERE"; break; + case ST_END_BLOCK: + p = "END BLOCK"; + break; case ST_END_BLOCK_DATA: p = "END BLOCK DATA"; break; @@ -2391,6 +2400,27 @@ parse_spec (gfc_statement st) } loop: + + /* If we're inside a BLOCK construct, some statements are disallowed. + Check this here. Attribute declaration statements like INTENT, OPTIONAL + or VALUE are also disallowed, but they don't have a particular ST_* + key so we have to check for them individually in their matcher routine. */ + if (gfc_current_state () == COMP_BLOCK) + switch (st) + { + case ST_IMPLICIT: + case ST_IMPLICIT_NONE: + case ST_NAMELIST: + case ST_COMMON: + case ST_EQUIVALENCE: + case ST_STATEMENT_FUNCTION: + gfc_error ("%s statement is not allowed inside of BLOCK at %C", + gfc_ascii_statement (st)); + break; + + default: + break; + } /* If we find a statement that can not be followed by an IMPLICIT statement (and thus we can expect to see none any further), type the function result @@ -2908,6 +2938,58 @@ check_do_closure (void) } +/* Parse a series of contained program units. */ + +static void parse_progunit (gfc_statement); + + +/* Parse a BLOCK construct. */ + +static void +parse_block_construct (void) +{ + 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; + + /* Give the BLOCK a symbol of flavor LABEL; this is later needed for correct + code generation (so it must not be NULL). + We set its recursive argument if our container procedure is recursive, so + that local variables are accordingly placed on the stack when it + will be necessary. */ + if (gfc_new_block) + my_ns->proc_name = gfc_new_block; + else + { + gfc_try t; + + gfc_get_symbol ("block@", my_ns, &my_ns->proc_name); + t = gfc_add_flavor (&my_ns->proc_name->attr, FL_LABEL, + my_ns->proc_name->name, NULL); + gcc_assert (t == SUCCESS); + } + my_ns->proc_name->attr.recursive = parent_ns->proc_name->attr.recursive; + + new_st.op = EXEC_BLOCK; + new_st.ext.ns = my_ns; + accept_statement (ST_BLOCK); + + push_state (&s, COMP_BLOCK, my_ns->proc_name); + gfc_current_ns = my_ns; + + parse_progunit (ST_NONE); + + gfc_current_ns = parent_ns; + pop_state (); +} + + /* Parse a DO loop. Note that the ST_CYCLE and ST_EXIT statements are handled inside of parse_executable(), because they aren't really loop statements. */ @@ -3301,6 +3383,10 @@ parse_executable (gfc_statement st) return ST_IMPLIED_ENDDO; break; + case ST_BLOCK: + parse_block_construct (); + break; + case ST_IF_BLOCK: parse_if_block (); break; @@ -3359,11 +3445,6 @@ parse_executable (gfc_statement st) } -/* Parse a series of contained program units. */ - -static void parse_progunit (gfc_statement); - - /* Fix the symbols for sibling functions. These are incorrectly added to the child namespace as the parser didn't know about this procedure. */ @@ -3545,7 +3626,7 @@ parse_contained (int module) } -/* Parse a PROGRAM, SUBROUTINE or FUNCTION unit. */ +/* Parse a PROGRAM, SUBROUTINE, FUNCTION unit or BLOCK construct. */ static void parse_progunit (gfc_statement st) @@ -3560,7 +3641,10 @@ parse_progunit (gfc_statement st) unexpected_eof (); case ST_CONTAINS: - goto contains; + /* This is not allowed within BLOCK! */ + if (gfc_current_state () != COMP_BLOCK) + goto contains; + break; case_end: accept_statement (st); @@ -3584,7 +3668,10 @@ loop: unexpected_eof (); case ST_CONTAINS: - goto contains; + /* This is not allowed within BLOCK! */ + if (gfc_current_state () != COMP_BLOCK) + goto contains; + break; case_end: accept_statement (st); |