trans.c (stmt_group_may_fallthru): New function.

	* gcc-interface/trans.c (stmt_group_may_fallthru): New function.
	(gnat_to_gnu) <N_Block_Statement>: Use it to find out whether the
	block needs to be translated.

From-SVN: r189612

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index eb1a526610eb8008080914d8287fe303e1b5a9bb..8f3ec6415093478836505bb2dc6e48a9dc51c4fc 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2012-07-18  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/trans.c (stmt_group_may_fallthru): New function.
+       (gnat_to_gnu) <N_Block_Statement>: Use it to find out whether the
+       block needs to be translated.
+
 2012-07-17  Tristan Gingold  <gingold@adacore.com>
 
        * gnat_rm.texi: Adjust previous change.

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 08a263a8e8e1a52df61471a69dd1814659a8b0bd..95b83fe31f6c8c4a3e36154904b00e3f7bd91837 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -244,6 +244,7 @@ static void add_cleanup (tree, Node_Id);
 static void add_stmt_list (List_Id);
 static void push_exception_label_stack (VEC(tree,gc) **, Entity_Id);
 static tree build_stmt_group (List_Id, bool);
+static inline bool stmt_group_may_fallthru (void);
 static enum gimplify_status gnat_gimplify_stmt (tree *);
 static void elaborate_all_entities (Node_Id);
 static void process_freeze_entity (Node_Id);
@@ -6197,12 +6198,18 @@ gnat_to_gnu (Node_Id gnat_node)
       break;
 
     case N_Block_Statement:
-      start_stmt_group ();
-      gnat_pushlevel ();
-      process_decls (Declarations (gnat_node), Empty, Empty, true, true);
-      add_stmt (gnat_to_gnu (Handled_Statement_Sequence (gnat_node)));
-      gnat_poplevel ();
-      gnu_result = end_stmt_group ();
+      /* The only way to enter the block is to fall through to it.  */
+      if (stmt_group_may_fallthru ())
+       {
+         start_stmt_group ();
+         gnat_pushlevel ();
+         process_decls (Declarations (gnat_node), Empty, Empty, true, true);
+         add_stmt (gnat_to_gnu (Handled_Statement_Sequence (gnat_node)));
+         gnat_poplevel ();
+         gnu_result = end_stmt_group ();
+       }
+      else
+       gnu_result = alloc_stmt_list ();
       break;
 
     case N_Exit_Statement:
@@ -7240,6 +7247,17 @@ end_stmt_group (void)
   return gnu_retval;
 }
 
+/* Return whether the current statement group may fall through.  */
+
+static inline bool
+stmt_group_may_fallthru (void)
+{
+  if (current_stmt_group->stmt_list)
+    return block_may_fallthru (current_stmt_group->stmt_list);
+  else
+    return true;
+}
+
 /* Add a list of statements from GNAT_LIST, a possibly-empty list of
    statements.*/
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2b24c72397aa27088106c3b77a1fd05d789bca84..3b0f299f2ce7eac59eb0230b3f9456023ccd5c17 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-07-18  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/noreturn4.ad[sb]: New test.
+       * gnat.dg/noreturn4_pkg.ads: New helper.
+
 2012-07-18  Jie Zhang  <jzhang918@gmail.com>
            Julian Brown  <julian@codesourcery.com>
 

diff --git a/gcc/testsuite/gnat.dg/noreturn4.adb b/gcc/testsuite/gnat.dg/noreturn4.adb
new file mode 100644 (file)
index 0000000..7225f6c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/noreturn4.adb
@@ -0,0 +1,21 @@
+-- { dg-do compile }
+
+with Noreturn4_Pkg; use Noreturn4_Pkg;
+
+package body Noreturn4 is
+
+  procedure P1 (Msg : String) is
+  begin
+     P1 (Msg, 0);
+  end;
+  procedure P1 (Msg : String; Val : Integer) is
+  begin
+     Fatal_Error (Value (It));
+  end;
+
+  procedure Fatal_Error (X : Integer) is
+  begin
+     raise PRogram_Error;
+  end;
+
+end Noreturn4;

diff --git a/gcc/testsuite/gnat.dg/noreturn4.ads b/gcc/testsuite/gnat.dg/noreturn4.ads
new file mode 100644 (file)
index 0000000..d6216da
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/noreturn4.ads
@@ -0,0 +1,10 @@
+package Noreturn4 is
+
+  procedure P1 (Msg : String);
+  procedure P1 (Msg : String; Val : Integer);
+  pragma No_Return (P1);
+
+  procedure Fatal_Error (X : Integer);
+  pragma No_Return (Fatal_Error);
+
+end Noreturn4;

diff --git a/gcc/testsuite/gnat.dg/noreturn4_pkg.ads b/gcc/testsuite/gnat.dg/noreturn4_pkg.ads
new file mode 100644 (file)
index 0000000..1d0029e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/noreturn4_pkg.ads
@@ -0,0 +1,18 @@
+with Ada.Finalization; use Ada.Finalization;
+
+package Noreturn4_Pkg is
+
+  type Priv is private;
+  function It return Priv;
+  function Value (Obj : Priv) return Integer;
+  function OK (Obj : Priv) return Boolean;
+
+private
+  type Priv is new Controlled with record
+     Value : Integer := 15;
+  end record;
+
+  procedure Adjust   (Obj : in out Priv);
+  procedure Finalize (Obj : in out Priv);
+
+end Noreturn4_Pkg;