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

gcc/fortran/ChangeLog

-2004-06-25  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
-	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.
+
+2004-06-26  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+	Andrew Vaught  <andyv@firstinter.net>
 
 	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  <kenner@vlsi1.ultra.nyu.edu>
+2004-06-22  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
 
 	* 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.
 

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;