===================================================================
@@ -112,6 +112,8 @@ gfc_get_intrinsic_sub_symbol (const char *name)
sym->attr.flavor = FL_PROCEDURE;
sym->attr.proc = PROC_INTRINSIC;
+ gfc_commit_symbol (sym);
+
return sym;
}
===================================================================
@@ -3880,6 +3880,9 @@ gen_cptr_param (gfc_formal_arglist **head,
formal_arg = gfc_get_formal_arglist ();
/* Add arg to list of formal args (the CPTR arg). */
add_formal_arg (head, tail, formal_arg, param_sym);
+
+ /* Validate changes. */
+ gfc_commit_symbol (param_sym);
}
@@ -3925,6 +3928,9 @@ gen_fptr_param (gfc_formal_arglist **head,
formal_arg = gfc_get_formal_arglist ();
/* Add arg to list of formal args. */
add_formal_arg (head, tail, formal_arg, param_sym);
+
+ /* Validate changes. */
+ gfc_commit_symbol (param_sym);
}
@@ -3997,6 +4003,9 @@ gen_shape_param (gfc_formal_arglist **head,
formal_arg = gfc_get_formal_arglist ();
/* Add arg to list of formal args. */
add_formal_arg (head, tail, formal_arg, param_sym);
+
+ /* Validate changes. */
+ gfc_commit_symbol (param_sym);
}
@@ -4059,6 +4068,9 @@ gfc_copy_formal_args (gfc_symbol *dest, gfc_symbol
/* Add arg to list of formal args. */
add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
+
+ /* Validate changes. */
+ gfc_commit_symbol (formal_arg->sym);
}
/* Add the interface to the symbol. */
@@ -4116,6 +4128,9 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_i
/* Add arg to list of formal args. */
add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
+
+ /* Validate changes. */
+ gfc_commit_symbol (formal_arg->sym);
}
/* Add the interface to the symbol. */
@@ -4169,6 +4184,9 @@ gfc_copy_formal_args_ppc (gfc_component *dest, gfc
/* Add arg to list of formal args. */
add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
+
+ /* Validate changes. */
+ gfc_commit_symbol (formal_arg->sym);
}
/* Add the interface to the symbol. */
@@ -4548,6 +4566,7 @@ generate_isocbinding_symbol (const char *mod_name,
default:
gcc_unreachable ();
}
+ gfc_commit_symbol (tmp_sym);
}
===================================================================
@@ -1892,13 +1892,12 @@ parse_derived_contains (void)
case ST_DATA_DECL:
gfc_error ("Components in TYPE at %C must precede CONTAINS");
- error_flag = true;
- break;
+ goto error;
case ST_PROCEDURE:
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Type-bound"
" procedure at %C") == FAILURE)
- error_flag = true;
+ goto error;
accept_statement (ST_PROCEDURE);
seen_comps = true;
@@ -1907,7 +1906,7 @@ parse_derived_contains (void)
case ST_GENERIC:
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: GENERIC binding"
" at %C") == FAILURE)
- error_flag = true;
+ goto error;
accept_statement (ST_GENERIC);
seen_comps = true;
@@ -1917,7 +1916,7 @@ parse_derived_contains (void)
if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: FINAL procedure declaration"
" at %C") == FAILURE)
- error_flag = true;
+ goto error;
accept_statement (ST_FINAL);
seen_comps = true;
@@ -1930,7 +1929,7 @@ parse_derived_contains (void)
&& (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type "
"definition at %C with empty CONTAINS "
"section") == FAILURE))
- error_flag = true;
+ goto error;
/* ST_END_TYPE is accepted by parse_derived after return. */
break;
@@ -1940,22 +1939,20 @@ parse_derived_contains (void)
{
gfc_error ("PRIVATE statement in TYPE at %C must be inside "
"a MODULE");
- error_flag = true;
- break;
+ goto error;
}
if (seen_comps)
{
gfc_error ("PRIVATE statement at %C must precede procedure"
" bindings");
- error_flag = true;
- break;
+ goto error;
}
if (seen_private)
{
gfc_error ("Duplicate PRIVATE statement at %C");
- error_flag = true;
+ goto error;
}
accept_statement (ST_PRIVATE);
@@ -1965,18 +1962,22 @@ parse_derived_contains (void)
case ST_SEQUENCE:
gfc_error ("SEQUENCE statement at %C must precede CONTAINS");
- error_flag = true;
- break;
+ goto error;
case ST_CONTAINS:
gfc_error ("Already inside a CONTAINS block at %C");
- error_flag = true;
- break;
+ goto error;
default:
unexpected_statement (st);
break;
}
+
+ continue;
+
+error:
+ error_flag = true;
+ reject_statement ();
}
pop_state ();
@@ -2395,7 +2396,10 @@ match_deferred_characteristics (gfc_typespec * ts)
gfc_commit_symbols ();
}
else
- gfc_error_check ();
+ {
+ gfc_error_check ();
+ gfc_undo_symbols ();
+ }
gfc_current_locus =loc;
return m;
@@ -2467,6 +2471,7 @@ loop:
case ST_STATEMENT_FUNCTION:
gfc_error ("%s statement is not allowed inside of BLOCK at %C",
gfc_ascii_statement (st));
+ reject_statement ();
break;
default:
@@ -2553,6 +2558,7 @@ declSt:
{
gfc_error ("%s statement must appear in a MODULE",
gfc_ascii_statement (st));
+ reject_statement ();
break;
}
@@ -2560,6 +2566,7 @@ declSt:
{
gfc_error ("%s statement at %C follows another accessibility "
"specification", gfc_ascii_statement (st));
+ reject_statement ();
break;
}
@@ -4004,6 +4011,7 @@ contains:
{
gfc_error ("CONTAINS statement at %C is already in a contained "
"program unit");
+ reject_statement ();
st = next_statement ();
goto loop;
}