static match match_case_eos(void) { char name[G95_MAX_SYMBOL_LEN+1], *block_name; match m; if (g95_match_eos() == MATCH_YES) return MATCH_YES; g95_gobble_whitespace(); m = g95_match_name(name); if (m != MATCH_YES) return m; block_name = g95_current_block_name(); if (strcmp(name, block_name) != 0) { g95_error("Expected case name of '%s' at %L", block_name, &g95_def_locus); return MATCH_ERROR; } return g95_match_eos(); }
static try check_format(void) { char *error, *posint_required = "Positive width required", *period_required = "Period required", *nonneg_required = "Nonnegative width required", *unexpected_element = "Unexpected element", *unexpected_end = "Unexpected end of format string"; format_token l, c; int m; try r; use_last_char = 0; saved_token = FMT_NONE; m = 0; r = SUCCESS; l = format_lex(); if (l != FMT_LPAREN) { error = "Missing leading left parenthesis"; goto syntax; } /* In this state, the next thing has to be a format item */ format_item: l = format_lex(); switch(l) { case FMT_POSINT: l = format_lex(); if (l == FMT_LPAREN) { m++; goto format_item; } if (l == FMT_SLASH) goto optional_comma; goto data_desc; case FMT_ZERO: l = format_lex(); if (l != FMT_P) { error = "Zero repeat count not allowed"; goto syntax; } goto p_descriptor; case FMT_LPAREN: m++; goto format_item; case FMT_RPAREN: goto rparen; case FMT_SIGNED_INT: /* Signed integer can only precede a P format */ l = format_lex(); if (l != FMT_P) { error = "Expected P edit descriptor"; goto syntax; } goto data_desc; case FMT_P: /* P and X require a prior number */ error = "P descriptor requires leading scale factor"; goto syntax; case FMT_X: error = "X descriptor requires leading space count"; goto syntax; case FMT_SIGN: case FMT_BLANK: case FMT_CHAR: goto between_desc; case FMT_COLON: case FMT_SLASH: goto optional_comma; case FMT_DOLLAR: l = format_lex(); if (l != FMT_RPAREN || m > 0) { error = "$ must the last specifier"; goto syntax; } goto finished; case FMT_POS: case FMT_IBOZ: case FMT_F: case FMT_E: case FMT_EXT: case FMT_G: case FMT_L: case FMT_A: case FMT_D: goto data_desc; case FMT_H: repeat = 1; goto handle_hollerith; case FMT_END: error = unexpected_end; goto syntax; default: error = unexpected_element; goto syntax; } /* In this state, t must currently be a data descriptor. Deal with * things that can/must follow the descriptor */ data_desc: switch(l) { case FMT_SIGN: case FMT_BLANK: case FMT_X: break; case FMT_P: p_descriptor: if (g95_option.fmode != 0) { l = format_lex(); if (l == FMT_POSINT) { error = "Repeat count cannot follow P descriptor"; goto syntax; } saved_token = l; } goto optional_comma; case FMT_POS: case FMT_L: l = format_lex(); if (l == FMT_POSINT) break; error = posint_required; goto syntax; case FMT_A: l = format_lex(); if (l != FMT_POSINT) saved_token = l; break; case FMT_D: case FMT_E: case FMT_G: case FMT_EXT: c = format_lex(); if (c != FMT_POSINT) { error = posint_required; goto syntax; } c = format_lex(); if (c != FMT_PERIOD) { error = period_required; goto syntax; } c = format_lex(); if (c != FMT_ZERO && c != FMT_POSINT) { error = nonneg_required; goto syntax; } if (l == FMT_D) break; /* Look for optional exponent */ c = format_lex(); if (c != FMT_E) { saved_token = c; } else { c = format_lex(); if (c != FMT_POSINT) { error = "Positive exponent width required"; goto syntax; } } break; case FMT_F: l = format_lex(); if (l != FMT_ZERO && l != FMT_POSINT) { error = nonneg_required; goto syntax; } l = format_lex(); if (l != FMT_PERIOD) { error = period_required; goto syntax; } l = format_lex(); if (l != FMT_ZERO && l != FMT_POSINT) { error = nonneg_required; goto syntax; } break; case FMT_H: handle_hollerith: if (g95_option.fmode != 0) { error = "The H format specifier is a deleted language feature"; goto syntax; } while(repeat>0) { if (next_char(0) == '\0') { error = unexpected_end; goto syntax; } repeat--; } break; case FMT_IBOZ: l = format_lex(); if (l != FMT_ZERO && l != FMT_POSINT) { error = nonneg_required; goto syntax; } l = format_lex(); if (l != FMT_PERIOD) { saved_token = l; } else { l = format_lex(); if (l != FMT_ZERO && l != FMT_POSINT) { error = nonneg_required; goto syntax; } } break; default: error = unexpected_element; goto syntax; } /* Between a descriptor and what comes next */ between_desc: l = format_lex(); switch(l) { case FMT_COMMA: goto format_item; case FMT_RPAREN: rparen: m--; if (m < 0) goto finished; goto between_desc; case FMT_COLON: case FMT_SLASH: goto optional_comma; case FMT_END: error = unexpected_end; goto syntax; default: error = "Missing comma"; goto syntax; } /* Optional comma is a weird between state where we've just finished * reading a colon, slash or P descriptor. */ optional_comma: l = format_lex(); switch(l) { case FMT_COMMA: break; case FMT_RPAREN: m--; if (m < 0) goto finished; goto between_desc; default: /* Assume that we have another format item */ saved_token = l; break; } goto format_item; /* Something went wrong. If the format we're checking is a string, * generate a warning, since the program is correct. If the format is * in a FORMAT statement, this messes up parsing, which is an error. */ syntax: if (mode != MODE_STRING) g95_error("%s in format string at %L", error, &where); else g95_warning(100, "%s in format string at %L", error, &where); r = FAILURE; finished: return r; } /* g95_match_format()-- Match a FORMAT statement. This amounts to * actually parsing the format descriptors in order to correctly * locate the end of the format string. */ match g95_match_format(void) { g95_locus sta; g95_expr *g; if (g95_statement_label == NULL) { g95_error("FORMAT statement at %C does not have a statement label"); return MATCH_ERROR; } g95_gobble_whitespace(); mode = MODE_FORMAT; format_length = 0; sta = where = new_where = g95_current_locus; if (check_format() == FAILURE) return MATCH_ERROR; if (g95_match_eos() != MATCH_YES) { g95_syntax_error(ST_FORMAT); return MATCH_ERROR; } /* The label doesn't get created until after the statement is done * being matched, so we have to leave the string for later. */ g95_current_locus = sta; /* Back to the beginning */ g = g95_get_expr(); g->type = EXPR_CONSTANT; g->ts.type = BT_CHARACTER; g->ts.kind = g95_default_character_kind(); g->where = sta; g->value.character.string = format_string = g95_getmem(format_length+1); g->value.character.length = format_length; g95_statement_label->format = g; mode = MODE_COPY; check_format(); /* Guaranteed to succeed */ g95_match_eos(); /* Guaranteed to succeed */ new_st.type = EXEC_NOP; return MATCH_YES; }