This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix spurious 'noreturn' function does return warning at -O0 (1)
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Wed, 18 Jul 2012 14:21:27 +0200
- Subject: [Ada] Fix spurious 'noreturn' function does return warning at -O0 (1)
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 <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-18 Eric Botcazou <ebotcazou@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;