@@ -189,7 +189,6 @@ procedure Gnatls is
-- Print usage message
procedure Output_License_Information;
- pragma No_Return (Output_License_Information);
-- Output license statement, and if not found, output reference to COPYING
function Image (Restriction : Restriction_Id) return String;
@@ -894,8 +893,6 @@ procedure Gnatls is
& " for license terms.");
Write_Eol;
end case;
-
- Exit_Program (E_Success);
end Output_License_Information;
-------------------
@@ -187,7 +187,9 @@ package body GNAT.Sockets.Thin is
return Res;
end if;
- declare
+ pragma Warnings (Off, "unreachable code");
+ declare -- unreachable if Thread_Blocking_IO is statically True
+ pragma Warnings (On, "unreachable code");
WSet : aliased Fd_Set;
Now : aliased Timeval;
@@ -4425,7 +4425,7 @@ package body Sem_Ch5 is
if not (Present (Current_Subprogram)
and then Ekind (Current_Subprogram) = E_Function
- and then (Nkind (Original_Node (N)) = N_Raise_Statement
+ and then (Nkind (N) in N_Raise_Statement
or else
(Nkind (N) = N_Procedure_Call_Statement
and then Is_Entity_Name (Name (N))
@@ -4444,39 +4444,59 @@ package body Sem_Ch5 is
-- unreachable code, since it is useless and we don't want
-- to generate junk warnings.
- -- We skip this step if we are not in code generation mode
- -- or CodePeer mode.
+ -- We skip this step if we are not in code generation mode.
-- This is the one case where we remove dead code in the
-- semantics as opposed to the expander, and we do not want
-- to remove code if we are not in code generation mode, since
-- this messes up the tree or loses useful information for
- -- CodePeer.
+ -- analysis tools such as CodePeer.
-- Note that one might react by moving the whole circuit to
-- exp_ch5, but then we lose the warning in -gnatc mode.
- if Operating_Mode = Generate_Code
- and then not CodePeer_Mode
- then
+ if Operating_Mode = Generate_Code then
loop
- Nxt := Next (N);
-
- -- Quit deleting when we have nothing more to delete
- -- or if we hit a label (since someone could transfer
- -- control to a label, so we should not delete it).
+ declare
+ Del : constant Node_Id := Next (N);
+ -- Node to be possibly deleted
+ begin
+ -- Quit deleting when we have nothing more to delete
+ -- or if we hit a label (since someone could transfer
+ -- control to a label, so we should not delete it).
- exit when No (Nxt) or else Nkind (Nxt) = N_Label;
+ exit when No (Del) or else Nkind (Del) = N_Label;
- -- Statement/declaration is to be deleted
+ -- Statement/declaration is to be deleted
- Analyze (Nxt);
- Remove (Nxt);
- Kill_Dead_Code (Nxt);
+ Analyze (Del);
+ Kill_Dead_Code (Del);
+ Remove (Del);
+ end;
end loop;
+
+ -- If this is a function, we add "raise Program_Error;",
+ -- because otherwise, we will get incorrect warnings about
+ -- falling off the end of the function.
+
+ declare
+ Subp : constant Entity_Id := Current_Subprogram;
+ begin
+ if Present (Subp) and then Ekind (Subp) = E_Function then
+ Insert_After_And_Analyze (N,
+ Make_Raise_Program_Error (Sloc (Error_Node),
+ Reason => PE_Missing_Return));
+ end if;
+ end;
+
end if;
- Error_Msg_N ("??unreachable code!", Error_Node);
+ -- Suppress the warning in instances, because a statement can
+ -- be unreachable in some instances but not others.
+
+ if not In_Instance then
+ Error_Msg_N ("??unreachable code!", Error_Node);
+ end if;
end if;
-- If the unconditional transfer of control instruction is the
@@ -4535,9 +4555,33 @@ package body Sem_Ch5 is
end if;
-- This was one of the cases we are looking for (i.e. the parent
- -- construct was IF, CASE or block) so decrement count.
-
- Unblocked_Exit_Count := Unblocked_Exit_Count - 1;
+ -- construct was IF, CASE or block). In most cases, we simply
+ -- decrement the count. However, if the parent is something like:
+ --
+ -- if cond then
+ -- raise ...; -- or some other jump
+ -- end if;
+ --
+ -- where cond is an expression that is known-true at compile time,
+ -- we can treat that as just the jump -- i.e. anything following
+ -- the if statement is unreachable. We don't do this for simple
+ -- cases like "if True" or "if Debug_Flag", because that causes
+ -- too many warnings.
+
+ if Nkind (P) = N_If_Statement
+ and then Present (Then_Statements (P))
+ and then No (Elsif_Parts (P))
+ and then No (Else_Statements (P))
+ and then Is_OK_Static_Expression (Condition (P))
+ and then Is_True (Expr_Value (Condition (P)))
+ and then not Is_Trivial_Boolean (Condition (P))
+ and then not Is_Static_Constant_Name (Condition (P))
+ then
+ pragma Assert (Unblocked_Exit_Count = 2);
+ Unblocked_Exit_Count := 0;
+ else
+ Unblocked_Exit_Count := Unblocked_Exit_Count - 1;
+ end if;
end if;
end if;
end Check_Unreachable_Code;
@@ -7564,6 +7564,8 @@ package body Sem_Ch6 is
Err : out Boolean;
Proc : Entity_Id := Empty)
is
+ pragma Assert (Mode in 'F' | 'P');
+ pragma Assert (if Mode = 'F' then No (Proc));
Handler : Node_Id;
procedure Check_Statement_Sequence (L : List_Id);
@@ -7613,15 +7615,13 @@ package body Sem_Ch6 is
-- Local variables
- Raise_Exception_Call : Boolean;
+ Raise_Exception_Call : Boolean := False;
-- Set True if statement sequence terminated by Raise_Exception call
-- or a Reraise_Occurrence call.
-- Start of processing for Check_Statement_Sequence
begin
- Raise_Exception_Call := False;
-
-- Get last real statement
Last_Stm := Last (L);
@@ -7687,7 +7687,8 @@ package body Sem_Ch6 is
while Nkind (Last_Stm) = N_Pragma
- -- Don't count call to SS_Release (can happen after Raise_Exception)
+ -- Don't count call to SS_Release (can happen after
+ -- Raise_Exception).
or else
(Nkind (Last_Stm) = N_Procedure_Call_Statement
@@ -7696,7 +7697,7 @@ package body Sem_Ch6 is
and then
Is_RTE (Entity (Name (Last_Stm)), RE_SS_Release))
- -- Don't count exception junk
+ -- Don't count exception junk
or else
(Nkind (Last_Stm) in
@@ -7704,10 +7705,12 @@ package body Sem_Ch6 is
and then Exception_Junk (Last_Stm))
or else Nkind (Last_Stm) in N_Push_xxx_Label | N_Pop_xxx_Label
- -- Inserted code, such as finalization calls, is irrelevant: we only
- -- need to check original source.
+ -- Inserted code, such as finalization calls, is irrelevant; we
+ -- only need to check original source. If we see a transfer of
+ -- control, we stop.
- or else Is_Rewrite_Insertion (Last_Stm)
+ or else (Is_Rewrite_Insertion (Last_Stm)
+ and then not Is_Transfer (Last_Stm))
loop
Prev (Last_Stm);
end loop;
@@ -6694,7 +6694,7 @@ package body Sem_Prag is
if Loc not in Source_First (Sindex) .. Source_Last (Sindex) then
-- We do not want to raise an exception here since this code
-- is part of the bootstrap path where we cannot rely on
- -- exception proapgation working.
+ -- exception propagation working.
-- Instead the caller should check for N being rewritten as
-- a null statement.
-- This code triggers when compiling a-except.adb.
@@ -7196,9 +7196,7 @@ package body Sem_Res is
-- Check unreachable code after calls to procedures with No_Return
- if Ekind (Nam) = E_Procedure
- and then No_Return (Nam)
- then
+ if Ekind (Nam) = E_Procedure and then No_Return (Nam) then
Check_Unreachable_Code (N);
end if;
@@ -4868,9 +4868,6 @@ package body Sem_Util is
-- and post-state. Prag is a [refined] postcondition or a contract-cases
-- pragma. Result_Seen is set when the pragma mentions attribute 'Result
- function Is_Trivial_Boolean (N : Node_Id) return Boolean;
- -- Determine whether source node N denotes "True" or "False"
-
-------------------------------------------
-- Check_Result_And_Post_State_In_Pragma --
-------------------------------------------
@@ -5243,20 +5240,6 @@ package body Sem_Util is
end if;
end Check_Result_And_Post_State_In_Pragma;
- ------------------------
- -- Is_Trivial_Boolean --
- ------------------------
-
- function Is_Trivial_Boolean (N : Node_Id) return Boolean is
- begin
- return
- Comes_From_Source (N)
- and then Is_Entity_Name (N)
- and then (Entity (N) = Standard_True
- or else
- Entity (N) = Standard_False);
- end Is_Trivial_Boolean;
-
-- Local variables
Items : constant Node_Id := Contract (Subp_Id);
@@ -21501,19 +21484,15 @@ package body Sem_Util is
Kind : constant Node_Kind := Nkind (N);
begin
- if Kind = N_Simple_Return_Statement
- or else
- Kind = N_Extended_Return_Statement
- or else
- Kind = N_Goto_Statement
- or else
- Kind = N_Raise_Statement
- or else
- Kind = N_Requeue_Statement
+ if Kind in N_Simple_Return_Statement
+ | N_Extended_Return_Statement
+ | N_Goto_Statement
+ | N_Raise_Statement
+ | N_Requeue_Statement
then
return True;
- elsif (Kind = N_Exit_Statement or else Kind in N_Raise_xxx_Error)
+ elsif Kind in N_Exit_Statement | N_Raise_xxx_Error
and then No (Condition (N))
then
return True;
@@ -21542,6 +21521,29 @@ package body Sem_Util is
return No (U) or else U = Uint_1;
end Is_True;
+ ------------------------
+ -- Is_Trivial_Boolean --
+ ------------------------
+
+ function Is_Trivial_Boolean (N : Node_Id) return Boolean is
+ begin
+ return Comes_From_Source (N)
+ and then Nkind (N) in N_Identifier | N_Expanded_Name
+ and then Entity (N) in Standard_True | Standard_False;
+ end Is_Trivial_Boolean;
+
+ -----------------------------
+ -- Is_Static_Constant_Name --
+ -----------------------------
+
+ function Is_Static_Constant_Name (N : Node_Id) return Boolean is
+ begin
+ return Comes_From_Source (N)
+ and then Is_Static_Expression (N)
+ and then Nkind (N) in N_Identifier | N_Expanded_Name
+ and then Ekind (Entity (N)) = E_Constant;
+ end Is_Static_Constant_Name;
+
--------------------------------------
-- Is_Unchecked_Conversion_Instance --
--------------------------------------
@@ -2481,6 +2481,13 @@ package Sem_Util is
-- unconditional transfer of control at run time, i.e. the following
-- statement definitely will not be executed.
+ function Is_Trivial_Boolean (N : Node_Id) return Boolean;
+ -- Determine whether source node N denotes "True" or "False". Note that
+ -- this is not true for expressions that got folded to True or False.
+
+ function Is_Static_Constant_Name (N : Node_Id) return Boolean;
+ -- True if N is a name that statically denotes a static constant.
+
function Is_Unchecked_Conversion_Instance (Id : Entity_Id) return Boolean;
-- Determine whether an arbitrary entity denotes an instance of function
-- Ada.Unchecked_Conversion.
This patch removes a warning in examples like this: if cond then return; -- or other jump end if; X := ...; -- where the value is out of range where cond is known at compile time. It could, for example, be a generic formal parameter that is known to be True in some instances. As a side effect, this patch adds new warnings about unreachable code. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * gnatls.adb (Output_License_Information): Remove pragma No_Return; call sites deal with Exit_Program. * libgnat/g-socthi.adb (C_Connect): Suppress warning about unreachable code. * sem_ch5.adb (Check_Unreachable_Code): Special-case if statements with static conditions. If we remove unreachable code (including the return statement) from a function, add "raise Program_Error", so we won't warn about missing returns. Remove Original_Node in test for N_Raise_Statement; it's not needed. Remove test for CodePeer_Mode; if Operating_Mode = Generate_Code, then CodePeer_Mode can't be True. Misc cleanup. Do not reuse Nxt variable for unrelated purpose (the usage in the Kill_Dead_Code loop is entirely local to the loop). * sem_ch6.adb: Add check for Is_Transfer. Misc cleanup. * sem_prag.adb: Minor. * sem_res.adb: Minor. * sem_util.adb: Minor cleanup. (Is_Trivial_Boolean): Move to nonnested place, so it can be called from elsewhere. (Is_Static_Constant_Boolean): New function. * sem_util.ads (Is_Trivial_Boolean): Export. (Is_Static_Constant_Boolean): New function.