gfc_match_label (void)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
- gfc_state_data *p;
match m;
gfc_new_block = NULL;
return MATCH_ERROR;
}
- if (gfc_new_block->attr.flavor != FL_LABEL
- && gfc_add_flavor (&gfc_new_block->attr, FL_LABEL,
- gfc_new_block->name, NULL) == FAILURE)
- return MATCH_ERROR;
+ if (gfc_new_block->attr.flavor == FL_LABEL)
+ {
+ gfc_error ("Duplicate construct label '%s' at %C", name);
+ return MATCH_ERROR;
+ }
- for (p = gfc_state_stack; p; p = p->previous)
- if (p->sym == gfc_new_block)
- {
- gfc_error ("Label %s at %C already in use by a parent block",
- gfc_new_block->name);
- return MATCH_ERROR;
- }
+ if (gfc_add_flavor (&gfc_new_block->attr, FL_LABEL,
+ gfc_new_block->name, NULL) == FAILURE)
+ return MATCH_ERROR;
return MATCH_YES;
}
/* We try to match an easy arithmetic IF statement. This only happens
- * when just after having encountered a simple IF statement. This code
- * is really duplicate with parts of the gfc_match_if code, but this is
- * *much* easier. */
-match
-gfc_match_arithmetic_if (void)
+ when just after having encountered a simple IF statement. This code
+ is really duplicate with parts of the gfc_match_if code, but this is
+ *much* easier. */
+static match
+match_arithmetic_if (void)
{
gfc_st_label *l1, *l2, *l3;
gfc_expr *expr;
return MATCH_ERROR;
}
+ if (gfc_notify_std (GFC_STD_F95_DEL,
+ "Obsolete: arithmetic IF statement at %C") == FAILURE)
+ return MATCH_ERROR;
+
new_st.op = EXEC_ARITHMETIC_IF;
new_st.expr = expr;
new_st.label = l1;
gfc_free_expr (expr);
return MATCH_ERROR;
}
+
+ if (gfc_notify_std (GFC_STD_F95_DEL,
+ "Obsolete: arithmetic IF statement at %C")
+ == FAILURE)
+ return MATCH_ERROR;
new_st.op = EXEC_ARITHMETIC_IF;
new_st.expr = expr;
match ("exit", gfc_match_exit, ST_EXIT)
match ("forall", match_simple_forall, ST_FORALL)
match ("go to", gfc_match_goto, ST_GOTO)
- match ("if", gfc_match_arithmetic_if, ST_ARITHMETIC_IF)
+ match ("if", match_arithmetic_if, ST_ARITHMETIC_IF)
match ("inquire", gfc_match_inquire, ST_INQUIRE)
match ("nullify", gfc_match_nullify, ST_NULLIFY)
match ("open", gfc_match_open, ST_OPEN)
gfc_expr *e;
match m;
gfc_compile_state s;
-
- gfc_enclosing_unit (&s);
- if (s == COMP_PROGRAM
- && gfc_notify_std (GFC_STD_GNU, "Extension: RETURN statement in "
- "main program at %C") == FAILURE)
- return MATCH_ERROR;
+ int c;
e = NULL;
if (gfc_match_eos () == MATCH_YES)
goto cleanup;
}
- m = gfc_match ("% %e%t", &e);
+ if (gfc_current_form == FORM_FREE)
+ {
+ /* The following are valid, so we can't require a blank after the
+ RETURN keyword:
+ return+1
+ return(1) */
+ c = gfc_peek_char ();
+ if (ISALPHA (c) || ISDIGIT (c))
+ return MATCH_NO;
+ }
+
+ m = gfc_match (" %e%t", &e);
if (m == MATCH_YES)
goto done;
if (m == MATCH_ERROR)
return MATCH_ERROR;
done:
+ gfc_enclosing_unit (&s);
+ if (s == COMP_PROGRAM
+ && gfc_notify_std (GFC_STD_GNU, "Extension: RETURN statement in "
+ "main program at %C") == FAILURE)
+ return MATCH_ERROR;
+
new_st.op = EXEC_RETURN;
new_st.expr = e;
}
m = gfc_match_expr (&iter->start);
- if (m == MATCH_NO)
- goto syntax;
- if (m == MATCH_ERROR)
+ if (m != MATCH_YES)
goto cleanup;
if (gfc_match_char (':') != MATCH_YES)