This fixes a spurious 'noreturn' function does return warning at -O0 on code involving controlled types.
Tested on x86_64-suse-linux, applied on the mainline. 2012-07-18 Eric Botcazou <ebotca...@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-18 Eric Botcazou <ebotca...@adacore.com> * gnat.dg/noreturn4.ad[sb]: New test. * gnat.dg/noreturn4_pkg.ads: New helper. -- Eric Botcazou
Index: gcc-interface/trans.c =================================================================== --- gcc-interface/trans.c (revision 189607) +++ gcc-interface/trans.c (working copy) @@ -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.*/
-- { 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;
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;
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;