re PR fortran/39626 (Correctly implement details of Fortran 2008 BLOCK construct)

2009-09-29  Daniel Kraft  <d@domob.eu>

	PR fortran/39626
	* gfortran.h (enum gfc_statement): Add ST_BLOCK and ST_END_BLOCK.
	(struct gfc_namespace): Convert flags to bit-fields and add flag
	`construct_entities' for use with BLOCK constructs.
	(enum gfc_exec_code): Add EXEC_BLOCK.
	(struct gfc_code): Add namespace field to union for EXEC_BLOCK.
	* match.h (gfc_match_block): New prototype.
	* parse.h (enum gfc_compile_state): Add COMP_BLOCK.
	* trans.h (gfc_process_block_locals): New prototype.
	(gfc_trans_deferred_vars): Made public, new prototype.
	* trans-stmt.h (gfc_trans_block_construct): New prototype.
	* decl.c (gfc_match_end): Handle END BLOCK correctly.
	(gfc_match_intent): Error if inside of BLOCK.
	(gfc_match_optional), (gfc_match_value): Ditto.
	* match.c (gfc_match_block): New routine.
	* parse.c (decode_statement): Handle BLOCK statement.
	(case_exec_markers): Add ST_BLOCK.
	(case_end): Add ST_END_BLOCK.
	(gfc_ascii_statement): Handle ST_BLOCK and ST_END_BLOCK.
	(parse_spec): Check for statements not allowed inside of BLOCK.
	(parse_block_construct): New routine.
	(parse_executable): Parse BLOCKs.
	(parse_progunit): Disallow CONTAINS in BLOCK constructs.
	* resolve.c (is_illegal_recursion): Find real container procedure and
	don't get confused by BLOCK constructs.
	(resolve_block_construct): New routine.
	(gfc_resolve_blocks), (resolve_code): Handle EXEC_BLOCK.
	* st.c (gfc_free_statement): Handle EXEC_BLOCK statements.
	* trans-decl.c (saved_local_decls): New static variable.
	(add_decl_as_local): New routine.
	(gfc_finish_var_decl): Add variable as local if inside BLOCK.
	(gfc_trans_deferred_vars): Make public.
	(gfc_process_block_locals): New routine.
	* trans-stmt.c (gfc_trans_block_construct): New routine.
	* trans.c (gfc_trans_code): Handle EXEC_BLOCK statements.

2009-09-29  Daniel Kraft  <d@domob.eu>

	PR fortran/39626
	* gfortran.dg/block_1.f08: New test.
	* gfortran.dg/block_2.f08: New test.
	* gfortran.dg/block_3.f90: New test.
	* gfortran.dg/block_4.f08: New test.
	* gfortran.dg/block_5.f08: New test.
	* gfortran.dg/block_6.f08: New test.
	* gfortran.dg/block_7.f08: New test.
	* gfortran.dg/block_8.f08: New test.

From-SVN: r152266

1 files changed, 33 insertions, 4 deletions

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 3ce7fd4..cfd8b81 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -5344,8 +5344,8 @@ set_enum_kind(void)
 
 
 /* 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.  */
+   END to the caller.  The END INTERFACE, END IF, END DO, END SELECT
+   and END BLOCK statements cannot be replaced by a single END statement.  */
 
 match
 gfc_match_end (gfc_statement *st)
@@ -5366,6 +5366,9 @@ gfc_match_end (gfc_statement *st)
   block_name = gfc_current_block () == NULL
 	     ? NULL : gfc_current_block ()->name;
 
+  if (state == COMP_BLOCK && !strcmp (block_name, "block@"))
+    block_name = NULL;
+
   if (state == COMP_CONTAINS || state == COMP_DERIVED_CONTAINS)
     {
       state = gfc_state_stack->previous->state;
@@ -5419,6 +5422,12 @@ gfc_match_end (gfc_statement *st)
       eos_ok = 0;
       break;
 
+    case COMP_BLOCK:
+      *st = ST_END_BLOCK;
+      target = " block";
+      eos_ok = 0;
+      break;
+
     case COMP_IF:
       *st = ST_ENDIF;
       target = " if";
@@ -5488,10 +5497,10 @@ gfc_match_end (gfc_statement *st)
     {
 
       if (*st != ST_ENDDO && *st != ST_ENDIF && *st != ST_END_SELECT
-	  && *st != ST_END_FORALL && *st != ST_END_WHERE)
+	  && *st != ST_END_FORALL && *st != ST_END_WHERE && *st != ST_END_BLOCK)
 	return MATCH_YES;
 
-      if (gfc_current_block () == NULL)
+      if (!block_name)
 	return MATCH_YES;
 
       gfc_error ("Expected block name of '%s' in %s statement at %C",
@@ -5854,6 +5863,13 @@ gfc_match_intent (void)
 {
   sym_intent intent;
 
+  /* This is not allowed within a BLOCK construct!  */
+  if (gfc_current_state () == COMP_BLOCK)
+    {
+      gfc_error ("INTENT is not allowed inside of BLOCK at %C");
+      return MATCH_ERROR;
+    }
+
   intent = match_intent_spec ();
   if (intent == INTENT_UNKNOWN)
     return MATCH_ERROR;
@@ -5879,6 +5895,12 @@ gfc_match_intrinsic (void)
 match
 gfc_match_optional (void)
 {
+  /* This is not allowed within a BLOCK construct!  */
+  if (gfc_current_state () == COMP_BLOCK)
+    {
+      gfc_error ("OPTIONAL is not allowed inside of BLOCK at %C");
+      return MATCH_ERROR;
+    }
 
   gfc_clear_attr (&current_attr);
   current_attr.optional = 1;
@@ -6362,6 +6384,13 @@ gfc_match_value (void)
   gfc_symbol *sym;
   match m;
 
+  /* This is not allowed within a BLOCK construct!  */
+  if (gfc_current_state () == COMP_BLOCK)
+    {
+      gfc_error ("VALUE is not allowed inside of BLOCK at %C");
+      return MATCH_ERROR;
+    }
+
   if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: VALUE statement at %C")
       == FAILURE)
     return MATCH_ERROR;