re PR fortran/44709 (BLOCK and GOTO/EXIT/CYCLE)

2010-07-23  Daniel Kraft  <d@domob.eu>

	PR fortran/44709
	* gfortran.h (gfc_find_symtree_in_proc): New method.
	* symbol.c (gfc_find_symtree_in_proc): New method.
	* match.c (match_exit_cycle): Look for loop name also in parent
	namespaces within current procedure.

2010-07-23  Daniel Kraft  <d@domob.eu>

	PR fortran/44709
	* gfortran.dg/exit_1.f08: New test.
	* gfortran.dg/exit_2.f08: New test.

From-SVN: r162450

gcc/fortran/ChangeLog

+2010-07-23  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/44709
+	* gfortran.h (gfc_find_symtree_in_proc): New method.
+	* symbol.c (gfc_find_symtree_in_proc): New method.
+	* match.c (match_exit_cycle): Look for loop name also in parent
+	namespaces within current procedure.
+
 2010-07-22  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/45019

gcc/fortran/gfortran.h

@@ -2512,6 +2512,7 @@ gfc_user_op *gfc_get_uop (const char *);
 gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
 void gfc_free_symbol (gfc_symbol *);
 gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
+gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *);
 int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
 int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
 int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);

gcc/fortran/match.c

@@ -2006,7 +2006,10 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
     sym = NULL;
   else
     {
-      m = gfc_match ("% %s%t", &sym);
+      char name[GFC_MAX_SYMBOL_LEN + 1];
+      gfc_symtree* stree;
+
+      m = gfc_match ("% %n%t", name);
       if (m == MATCH_ERROR)
 	return MATCH_ERROR;
       if (m == MATCH_NO)
@@ -2015,10 +2018,22 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
 	  return MATCH_ERROR;
 	}
 
+      /* Find the corresponding symbol.  If there's a BLOCK statement
+	 between here and the label, it is not in gfc_current_ns but a parent
+	 namespace!  */
+      stree = gfc_find_symtree_in_proc (name, gfc_current_ns);
+      if (!stree)
+	{
+	  gfc_error ("Name '%s' in %s statement at %C is unknown",
+		     name, gfc_ascii_statement (st));
+	  return MATCH_ERROR;
+	}
+
+      sym = stree->n.sym;
       if (sym->attr.flavor != FL_LABEL)
 	{
 	  gfc_error ("Name '%s' in %s statement at %C is not a loop name",
-		     sym->name, gfc_ascii_statement (st));
+		     name, gfc_ascii_statement (st));
 	  return MATCH_ERROR;
 	}
     }

gcc/fortran/symbol.c

@@ -2565,6 +2565,27 @@ select_type_insert_tmp (gfc_symtree **st)
 }
 
 
+/* Look for a symtree in the current procedure -- that is, go up to
+   parent namespaces but only if inside a BLOCK.  Returns NULL if not found.  */
+
+gfc_symtree*
+gfc_find_symtree_in_proc (const char* name, gfc_namespace* ns)
+{
+  while (ns)
+    {
+      gfc_symtree* st = gfc_find_symtree (ns->sym_root, name);
+      if (st)
+	return st;
+
+      if (!ns->construct_entities)
+	break;
+      ns = ns->parent;
+    }
+
+  return NULL;
+}
+
+
 /* Search for a symtree starting in the current namespace, resorting to
    any parent namespaces if requested by a nonzero parent_flag.
    Returns nonzero if the name is ambiguous.  */

gcc/testsuite/ChangeLog

+2010-07-23  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/44709
+	* gfortran.dg/exit_1.f08: New test.
+	* gfortran.dg/exit_2.f08: New test.
+
 2010-07-22  Sandra Loosemore  <sandra@codesourcery.com>
 
 	PR tree-optimization/39839

gcc/testsuite/gfortran.dg/exit_1.f08

+! { dg-do run }
+! { dg-options "-std=f2008 -fall-intrinsics" }
+
+! PR fortran/44709
+! Check that exit and cycle from within a BLOCK works for loops as expected.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  INTEGER :: i
+  
+  ! Simple exit without loop name.
+  DO
+    BLOCK
+      EXIT
+    END BLOCK
+    CALL abort ()
+  END DO
+
+  ! Cycle without loop name.
+  DO i = 1, 1
+    BLOCK
+      CYCLE
+    END BLOCK
+    CALL abort ()
+  END DO
+
+  ! Exit loop by name from within a BLOCK.
+  loop1: DO
+    DO
+      BLOCK
+        EXIT loop1
+      END BLOCK
+      CALL abort ()
+    END DO
+    CALL abort ()
+  END DO loop1
+
+  ! Cycle loop by name from within a BLOCK.
+  loop2: DO i = 1, 1
+    loop3: DO
+      BLOCK
+        CYCLE loop2
+      END BLOCK
+      CALL abort ()
+    END DO loop3
+    CALL abort ()
+  END DO loop2
+END PROGRAM main

gcc/testsuite/gfortran.dg/exit_2.f08

+! { dg-do compile }
+! { dg-options "-std=f2008" }
+
+! PR fortran/44709
+! Check that the resolving of loop names in parent namespaces introduced to
+! handle intermediate BLOCK's does not go too far and other sanity checks.
+
+! Contributed by Daniel Kraft, d@domob.eu.
+
+PROGRAM main
+  IMPLICIT NONE
+  
+  EXIT ! { dg-error "is not within a loop" }
+  EXIT foobar ! { dg-error "is unknown" }
+  EXIT main ! { dg-error "is not a loop name" }
+
+  mainLoop: DO
+    CALL test ()
+  END DO mainLoop
+
+  otherLoop: DO
+    EXIT mainLoop ! { dg-error "is not within loop 'mainloop'" }
+  END DO otherLoop
+
+CONTAINS
+
+  SUBROUTINE test ()
+    EXIT mainLoop ! { dg-error "is unknown" }
+  END SUBROUTINE test
+
+END PROGRAM main