Commit ef973f3f by Mikael Morin

re PR fortran/42051 ([OOP] ICE on array-valued function with CLASS formal argument)

2010-08-02  Mikael Morin  <mikael@gcc.gnu.org>
	    Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42051
	PR fortran/44064
	PR fortran/45151
	* intrinsic.c (gfc_get_intrinsic_sub_symbol): Commit changed symbol. 
	* symbol.c (gen_cptr_param, gen_fptr_param, gen_shape_param,
	gfc_copy_formal_args, gfc_copy_formal_args_intr,
	gfc_copy_formal_args_ppc, generate_isocbinding_symbol): Ditto.
	* parse.c (parse_derived_contains, parse_spec, parse_progunit): 
	Call reject_statement in case of error. 
	(match_deferred_characteritics): Call gfc_undo_symbols in case match
	fails.


Co-Authored-By: Janus Weil <janus@gcc.gnu.org>

From-SVN: r162821
parent 13cc4787
2010-08-02 Mikael Morin <mikael@gcc.gnu.org>
Janus Weil <janus@gcc.gnu.org>
PR fortran/42051
PR fortran/44064
PR fortran/45151
* intrinsic.c (gfc_get_intrinsic_sub_symbol): Commit changed symbol.
* symbol.c (gen_cptr_param, gen_fptr_param, gen_shape_param,
gfc_copy_formal_args, gfc_copy_formal_args_intr,
gfc_copy_formal_args_ppc, generate_isocbinding_symbol): Ditto.
* parse.c (parse_derived_contains, parse_spec, parse_progunit):
Call reject_statement in case of error.
(match_deferred_characteritics): Call gfc_undo_symbols in case match
fails.
2010-08-01 Janus Weil <janus@gcc.gnu.org> 2010-08-01 Janus Weil <janus@gcc.gnu.org>
PR fortran/44912 PR fortran/44912
......
...@@ -112,6 +112,8 @@ gfc_get_intrinsic_sub_symbol (const char *name) ...@@ -112,6 +112,8 @@ gfc_get_intrinsic_sub_symbol (const char *name)
sym->attr.flavor = FL_PROCEDURE; sym->attr.flavor = FL_PROCEDURE;
sym->attr.proc = PROC_INTRINSIC; sym->attr.proc = PROC_INTRINSIC;
gfc_commit_symbol (sym);
return sym; return sym;
} }
......
...@@ -1892,13 +1892,12 @@ parse_derived_contains (void) ...@@ -1892,13 +1892,12 @@ parse_derived_contains (void)
case ST_DATA_DECL: case ST_DATA_DECL:
gfc_error ("Components in TYPE at %C must precede CONTAINS"); gfc_error ("Components in TYPE at %C must precede CONTAINS");
error_flag = true; goto error;
break;
case ST_PROCEDURE: case ST_PROCEDURE:
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Type-bound" if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Type-bound"
" procedure at %C") == FAILURE) " procedure at %C") == FAILURE)
error_flag = true; goto error;
accept_statement (ST_PROCEDURE); accept_statement (ST_PROCEDURE);
seen_comps = true; seen_comps = true;
...@@ -1907,7 +1906,7 @@ parse_derived_contains (void) ...@@ -1907,7 +1906,7 @@ parse_derived_contains (void)
case ST_GENERIC: case ST_GENERIC:
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: GENERIC binding" if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: GENERIC binding"
" at %C") == FAILURE) " at %C") == FAILURE)
error_flag = true; goto error;
accept_statement (ST_GENERIC); accept_statement (ST_GENERIC);
seen_comps = true; seen_comps = true;
...@@ -1917,7 +1916,7 @@ parse_derived_contains (void) ...@@ -1917,7 +1916,7 @@ parse_derived_contains (void)
if (gfc_notify_std (GFC_STD_F2003, if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: FINAL procedure declaration" "Fortran 2003: FINAL procedure declaration"
" at %C") == FAILURE) " at %C") == FAILURE)
error_flag = true; goto error;
accept_statement (ST_FINAL); accept_statement (ST_FINAL);
seen_comps = true; seen_comps = true;
...@@ -1930,7 +1929,7 @@ parse_derived_contains (void) ...@@ -1930,7 +1929,7 @@ parse_derived_contains (void)
&& (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type " && (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type "
"definition at %C with empty CONTAINS " "definition at %C with empty CONTAINS "
"section") == FAILURE)) "section") == FAILURE))
error_flag = true; goto error;
/* ST_END_TYPE is accepted by parse_derived after return. */ /* ST_END_TYPE is accepted by parse_derived after return. */
break; break;
...@@ -1940,22 +1939,20 @@ parse_derived_contains (void) ...@@ -1940,22 +1939,20 @@ parse_derived_contains (void)
{ {
gfc_error ("PRIVATE statement in TYPE at %C must be inside " gfc_error ("PRIVATE statement in TYPE at %C must be inside "
"a MODULE"); "a MODULE");
error_flag = true; goto error;
break;
} }
if (seen_comps) if (seen_comps)
{ {
gfc_error ("PRIVATE statement at %C must precede procedure" gfc_error ("PRIVATE statement at %C must precede procedure"
" bindings"); " bindings");
error_flag = true; goto error;
break;
} }
if (seen_private) if (seen_private)
{ {
gfc_error ("Duplicate PRIVATE statement at %C"); gfc_error ("Duplicate PRIVATE statement at %C");
error_flag = true; goto error;
} }
accept_statement (ST_PRIVATE); accept_statement (ST_PRIVATE);
...@@ -1965,18 +1962,22 @@ parse_derived_contains (void) ...@@ -1965,18 +1962,22 @@ parse_derived_contains (void)
case ST_SEQUENCE: case ST_SEQUENCE:
gfc_error ("SEQUENCE statement at %C must precede CONTAINS"); gfc_error ("SEQUENCE statement at %C must precede CONTAINS");
error_flag = true; goto error;
break;
case ST_CONTAINS: case ST_CONTAINS:
gfc_error ("Already inside a CONTAINS block at %C"); gfc_error ("Already inside a CONTAINS block at %C");
error_flag = true; goto error;
break;
default: default:
unexpected_statement (st); unexpected_statement (st);
break; break;
} }
continue;
error:
error_flag = true;
reject_statement ();
} }
pop_state (); pop_state ();
...@@ -2395,7 +2396,10 @@ match_deferred_characteristics (gfc_typespec * ts) ...@@ -2395,7 +2396,10 @@ match_deferred_characteristics (gfc_typespec * ts)
gfc_commit_symbols (); gfc_commit_symbols ();
} }
else else
gfc_error_check (); {
gfc_error_check ();
gfc_undo_symbols ();
}
gfc_current_locus =loc; gfc_current_locus =loc;
return m; return m;
...@@ -2467,6 +2471,7 @@ loop: ...@@ -2467,6 +2471,7 @@ loop:
case ST_STATEMENT_FUNCTION: case ST_STATEMENT_FUNCTION:
gfc_error ("%s statement is not allowed inside of BLOCK at %C", gfc_error ("%s statement is not allowed inside of BLOCK at %C",
gfc_ascii_statement (st)); gfc_ascii_statement (st));
reject_statement ();
break; break;
default: default:
...@@ -2553,6 +2558,7 @@ declSt: ...@@ -2553,6 +2558,7 @@ declSt:
{ {
gfc_error ("%s statement must appear in a MODULE", gfc_error ("%s statement must appear in a MODULE",
gfc_ascii_statement (st)); gfc_ascii_statement (st));
reject_statement ();
break; break;
} }
...@@ -2560,6 +2566,7 @@ declSt: ...@@ -2560,6 +2566,7 @@ declSt:
{ {
gfc_error ("%s statement at %C follows another accessibility " gfc_error ("%s statement at %C follows another accessibility "
"specification", gfc_ascii_statement (st)); "specification", gfc_ascii_statement (st));
reject_statement ();
break; break;
} }
...@@ -4004,6 +4011,7 @@ contains: ...@@ -4004,6 +4011,7 @@ contains:
{ {
gfc_error ("CONTAINS statement at %C is already in a contained " gfc_error ("CONTAINS statement at %C is already in a contained "
"program unit"); "program unit");
reject_statement ();
st = next_statement (); st = next_statement ();
goto loop; goto loop;
} }
......
...@@ -3880,6 +3880,9 @@ gen_cptr_param (gfc_formal_arglist **head, ...@@ -3880,6 +3880,9 @@ gen_cptr_param (gfc_formal_arglist **head,
formal_arg = gfc_get_formal_arglist (); formal_arg = gfc_get_formal_arglist ();
/* Add arg to list of formal args (the CPTR arg). */ /* Add arg to list of formal args (the CPTR arg). */
add_formal_arg (head, tail, formal_arg, param_sym); 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, ...@@ -3925,6 +3928,9 @@ gen_fptr_param (gfc_formal_arglist **head,
formal_arg = gfc_get_formal_arglist (); formal_arg = gfc_get_formal_arglist ();
/* Add arg to list of formal args. */ /* Add arg to list of formal args. */
add_formal_arg (head, tail, formal_arg, param_sym); 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, ...@@ -3997,6 +4003,9 @@ gen_shape_param (gfc_formal_arglist **head,
formal_arg = gfc_get_formal_arglist (); formal_arg = gfc_get_formal_arglist ();
/* Add arg to list of formal args. */ /* Add arg to list of formal args. */
add_formal_arg (head, tail, formal_arg, param_sym); 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 *src) ...@@ -4059,6 +4068,9 @@ gfc_copy_formal_args (gfc_symbol *dest, gfc_symbol *src)
/* Add arg to list of formal args. */ /* Add arg to list of formal args. */
add_formal_arg (&head, &tail, formal_arg, formal_arg->sym); add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
/* Validate changes. */
gfc_commit_symbol (formal_arg->sym);
} }
/* Add the interface to the symbol. */ /* Add the interface to the symbol. */
...@@ -4116,6 +4128,9 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src) ...@@ -4116,6 +4128,9 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src)
/* Add arg to list of formal args. */ /* Add arg to list of formal args. */
add_formal_arg (&head, &tail, formal_arg, formal_arg->sym); add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
/* Validate changes. */
gfc_commit_symbol (formal_arg->sym);
} }
/* Add the interface to the symbol. */ /* Add the interface to the symbol. */
...@@ -4169,6 +4184,9 @@ gfc_copy_formal_args_ppc (gfc_component *dest, gfc_symbol *src) ...@@ -4169,6 +4184,9 @@ gfc_copy_formal_args_ppc (gfc_component *dest, gfc_symbol *src)
/* Add arg to list of formal args. */ /* Add arg to list of formal args. */
add_formal_arg (&head, &tail, formal_arg, formal_arg->sym); add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
/* Validate changes. */
gfc_commit_symbol (formal_arg->sym);
} }
/* Add the interface to the symbol. */ /* Add the interface to the symbol. */
...@@ -4548,6 +4566,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, ...@@ -4548,6 +4566,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
default: default:
gcc_unreachable (); gcc_unreachable ();
} }
gfc_commit_symbol (tmp_sym);
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment