From ddc9ce91157ab23b35e1127c695feb5889f3ff53 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Tobias=20Schl=C3=BCter?= Date: Sat, 26 Jun 2004 14:01:43 +0200 Subject: [PATCH] Andrew Vaught 2004-06-26 Tobias Schlueter Andrew Vaught * 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 --- gcc/fortran/ChangeLog | 15 +++++++++++---- gcc/fortran/decl.c | 41 +++++++++++++++++++++++++++++++---------- 2 files changed, 42 insertions(+), 14 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 581c7fab1d9..c93c9a49a53 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,11 +1,18 @@ -2004-06-25 Tobias Schlueter - Andrew Vaught +2004-06-26 Tobias Schlueter + Andrew Vaught + + * decl.c (contained_procedure): New function. + (match_end): Verify correctness of END STATEMENT in + all cases. + +2004-06-26 Tobias Schlueter + Andrew Vaught PR fortran/15190 * decl.c (gfc_match_type_spec), io.c (match_io), parse.c (decode_statement): Enforce required space in free-form. -2004-06-21 Richard Kenner +2004-06-22 Richard Kenner * f95-lang.c (LANG_HOOKS_GIMPLE_BEFORE_INLINING): Deleted. * trans-array.c (gfc_conv_descriptor_data): Add operand @@ -20,7 +27,7 @@ (transfer_expr): Likewise. * trans-decl.c (gfc_trans_auto_character_variable): 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. * trans.c (gfc_build_array_ref): Add two new operands for ARRAY_REF. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 2790865025f..4ccb0d4a6f8 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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 END to the caller. The END INTERFACE, END IF, END DO and END SELECT statements cannot be replaced by a single END statement. */ @@ -1797,6 +1813,7 @@ gfc_match_end (gfc_statement * st) locus old_loc; const char *block_name; const char *target; + int eos_ok; match m; old_loc = gfc_current_locus; @@ -1820,61 +1837,73 @@ gfc_match_end (gfc_statement * st) case COMP_PROGRAM: *st = ST_END_PROGRAM; target = " program"; + eos_ok = 1; break; case COMP_SUBROUTINE: *st = ST_END_SUBROUTINE; target = " subroutine"; + eos_ok = !contained_procedure (); break; case COMP_FUNCTION: *st = ST_END_FUNCTION; target = " function"; + eos_ok = !contained_procedure (); break; case COMP_BLOCK_DATA: *st = ST_END_BLOCK_DATA; target = " block data"; + eos_ok = 1; break; case COMP_MODULE: *st = ST_END_MODULE; target = " module"; + eos_ok = 1; break; case COMP_INTERFACE: *st = ST_END_INTERFACE; target = " interface"; + eos_ok = 0; break; case COMP_DERIVED: *st = ST_END_TYPE; target = " type"; + eos_ok = 0; break; case COMP_IF: *st = ST_ENDIF; target = " if"; + eos_ok = 0; break; case COMP_DO: *st = ST_ENDDO; target = " do"; + eos_ok = 0; break; case COMP_SELECT: *st = ST_END_SELECT; target = " select"; + eos_ok = 0; break; case COMP_FORALL: *st = ST_END_FORALL; target = " forall"; + eos_ok = 0; break; case COMP_WHERE: *st = ST_END_WHERE; target = " where"; + eos_ok = 0; break; default: @@ -1884,17 +1913,9 @@ gfc_match_end (gfc_statement * st) if (gfc_match_eos () == MATCH_YES) { - state = gfc_current_state (); - - 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)) + if (!eos_ok) { - + /* We would have required END [something] */ gfc_error ("%s statement expected at %C", gfc_ascii_statement (*st)); goto cleanup; -- 2.30.2