+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.
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);
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:
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.*/
+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>
--- /dev/null
+-- { 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;
--- /dev/null
+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;