diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 30 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/noreturn4.adb | 21 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/noreturn4.ads | 10 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/noreturn4_pkg.ads | 18 |
6 files changed, 84 insertions, 6 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index eb1a526..8f3ec64 100644 --- 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 08a263a..95b83fe 100644 --- 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 2b24c72..3b0f299 100644 --- 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 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 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 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; |