[Ada] Remove out-of-range warning in unreachable code

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.

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.

1 files changed, 65 insertions, 21 deletions

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index f38c213..b2a3661 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -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;