Commit ddc9ce91 by Tobias Schlüter

Andrew Vaught <andyv@firstinter.net>

2004-06-26  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
Andrew Vaught  <andyv@firstinter.net>

* decl.c (contained_procedure): New function.
(match_end): Verify correctness of END STATEMENT in
all cases.

Also fix two typos in Kenner's ChangeLog

From-SVN: r83710
parent 3e14aaa2
2004-06-25 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de> 2004-06-26 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
Andrew Vaught <andyv@firstinter.net> Andrew Vaught <andyv@firstinter.net>
* decl.c (contained_procedure): New function.
(match_end): Verify correctness of END STATEMENT in
all cases.
2004-06-26 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
Andrew Vaught <andyv@firstinter.net>
PR fortran/15190 PR fortran/15190
* decl.c (gfc_match_type_spec), io.c (match_io), parse.c * decl.c (gfc_match_type_spec), io.c (match_io), parse.c
(decode_statement): Enforce required space in free-form. (decode_statement): Enforce required space in free-form.
2004-06-21 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> 2004-06-22 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* f95-lang.c (LANG_HOOKS_GIMPLE_BEFORE_INLINING): Deleted. * f95-lang.c (LANG_HOOKS_GIMPLE_BEFORE_INLINING): Deleted.
* trans-array.c (gfc_conv_descriptor_data): Add operand * trans-array.c (gfc_conv_descriptor_data): Add operand
...@@ -20,7 +27,7 @@ ...@@ -20,7 +27,7 @@
(transfer_expr): Likewise. (transfer_expr): Likewise.
* trans-decl.c (gfc_trans_auto_character_variable): * trans-decl.c (gfc_trans_auto_character_variable):
Set up to get DECL_SIZE and DECL_SIZE_UNIT gimplified. Set up to get DECL_SIZE and DECL_SIZE_UNIT gimplified.
(gfc_simplify_function): New function. (gfc_gimplify_function): New function.
(gfc_generate_function-code): Properly handle nested functions. (gfc_generate_function-code): Properly handle nested functions.
* trans.c (gfc_build_array_ref): Add two new operands for ARRAY_REF. * trans.c (gfc_build_array_ref): Add two new operands for ARRAY_REF.
......
...@@ -1785,6 +1785,22 @@ gfc_match_subroutine (void) ...@@ -1785,6 +1785,22 @@ gfc_match_subroutine (void)
} }
/* Return nonzero if we're currenly compiling a contained procedure. */
static int
contained_procedure (void)
{
gfc_state_data *s;
for (s=gfc_state_stack; s; s=s->previous)
if ((s->state == COMP_SUBROUTINE || s->state == COMP_FUNCTION)
&& s->previous != NULL
&& s->previous->state == COMP_CONTAINS)
return 1;
return 0;
}
/* Match any of the various end-block statements. Returns the type of /* Match any of the various end-block statements. Returns the type of
END to the caller. The END INTERFACE, END IF, END DO and END END to the caller. The END INTERFACE, END IF, END DO and END
SELECT statements cannot be replaced by a single END statement. */ SELECT statements cannot be replaced by a single END statement. */
...@@ -1797,6 +1813,7 @@ gfc_match_end (gfc_statement * st) ...@@ -1797,6 +1813,7 @@ gfc_match_end (gfc_statement * st)
locus old_loc; locus old_loc;
const char *block_name; const char *block_name;
const char *target; const char *target;
int eos_ok;
match m; match m;
old_loc = gfc_current_locus; old_loc = gfc_current_locus;
...@@ -1820,61 +1837,73 @@ gfc_match_end (gfc_statement * st) ...@@ -1820,61 +1837,73 @@ gfc_match_end (gfc_statement * st)
case COMP_PROGRAM: case COMP_PROGRAM:
*st = ST_END_PROGRAM; *st = ST_END_PROGRAM;
target = " program"; target = " program";
eos_ok = 1;
break; break;
case COMP_SUBROUTINE: case COMP_SUBROUTINE:
*st = ST_END_SUBROUTINE; *st = ST_END_SUBROUTINE;
target = " subroutine"; target = " subroutine";
eos_ok = !contained_procedure ();
break; break;
case COMP_FUNCTION: case COMP_FUNCTION:
*st = ST_END_FUNCTION; *st = ST_END_FUNCTION;
target = " function"; target = " function";
eos_ok = !contained_procedure ();
break; break;
case COMP_BLOCK_DATA: case COMP_BLOCK_DATA:
*st = ST_END_BLOCK_DATA; *st = ST_END_BLOCK_DATA;
target = " block data"; target = " block data";
eos_ok = 1;
break; break;
case COMP_MODULE: case COMP_MODULE:
*st = ST_END_MODULE; *st = ST_END_MODULE;
target = " module"; target = " module";
eos_ok = 1;
break; break;
case COMP_INTERFACE: case COMP_INTERFACE:
*st = ST_END_INTERFACE; *st = ST_END_INTERFACE;
target = " interface"; target = " interface";
eos_ok = 0;
break; break;
case COMP_DERIVED: case COMP_DERIVED:
*st = ST_END_TYPE; *st = ST_END_TYPE;
target = " type"; target = " type";
eos_ok = 0;
break; break;
case COMP_IF: case COMP_IF:
*st = ST_ENDIF; *st = ST_ENDIF;
target = " if"; target = " if";
eos_ok = 0;
break; break;
case COMP_DO: case COMP_DO:
*st = ST_ENDDO; *st = ST_ENDDO;
target = " do"; target = " do";
eos_ok = 0;
break; break;
case COMP_SELECT: case COMP_SELECT:
*st = ST_END_SELECT; *st = ST_END_SELECT;
target = " select"; target = " select";
eos_ok = 0;
break; break;
case COMP_FORALL: case COMP_FORALL:
*st = ST_END_FORALL; *st = ST_END_FORALL;
target = " forall"; target = " forall";
eos_ok = 0;
break; break;
case COMP_WHERE: case COMP_WHERE:
*st = ST_END_WHERE; *st = ST_END_WHERE;
target = " where"; target = " where";
eos_ok = 0;
break; break;
default: default:
...@@ -1884,17 +1913,9 @@ gfc_match_end (gfc_statement * st) ...@@ -1884,17 +1913,9 @@ gfc_match_end (gfc_statement * st)
if (gfc_match_eos () == MATCH_YES) if (gfc_match_eos () == MATCH_YES)
{ {
state = gfc_current_state (); if (!eos_ok)
if (*st == ST_ENDIF || *st == ST_ENDDO || *st == ST_END_SELECT
|| *st == ST_END_INTERFACE || *st == ST_END_FORALL
|| *st == ST_END_WHERE
|| /* A contained procedure requires END FUNCTION/SUBROUTINE. */
((state == COMP_FUNCTION || state == COMP_SUBROUTINE)
&& gfc_state_stack->previous != NULL
&& gfc_state_stack->previous->state == COMP_CONTAINS))
{ {
/* We would have required END [something] */
gfc_error ("%s statement expected at %C", gfc_error ("%s statement expected at %C",
gfc_ascii_statement (*st)); gfc_ascii_statement (*st));
goto cleanup; goto cleanup;
......
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