sem_ch5.adb (Unblocked_Exit_Count): Now used for blocks as well as IF and CASE.

2004-10-04  Robert Dewar  <dewar@gnat.com>

	* sem_ch5.adb (Unblocked_Exit_Count): Now used for blocks as well as
	IF and CASE.
	(Analyze_Block_Statement): Add circuitry to detect following dead code
	(Check_Unreachable_Code): Handle case of block exit

From-SVN: r88503

gcc/ada/ChangeLog

 2004-10-04  Robert Dewar  <dewar@gnat.com>
 
+	* sem_ch5.adb (Unblocked_Exit_Count): Now used for blocks as well as
+	IF and CASE.
+	(Analyze_Block_Statement): Add circuitry to detect following dead code
+	(Check_Unreachable_Code): Handle case of block exit
+
+2004-10-04  Robert Dewar  <dewar@gnat.com>
+
 	* g-spipat.adb: (XMatch): Avoid warning for Logic_Error call
 	(XMatchD): Avoid warning for Logic_Error call
 

gcc/ada/sem_ch5.adb

@@ -54,13 +54,16 @@ with Uintp;    use Uintp;
 package body Sem_Ch5 is
 
    Unblocked_Exit_Count : Nat := 0;
-   --  This variable is used when processing if statements or case
-   --  statements, it counts the number of branches of the conditional
-   --  that are not blocked by unconditional transfer instructions. At
-   --  the end of processing, if the count is zero, it means that control
-   --  cannot fall through the conditional statement. This is used for
-   --  the generation of warning messages. This variable is recursively
-   --  saved on entry to processing an if or case, and restored on exit.
+   --  This variable is used when processing if statements, case statements,
+   --  and block statements. It counts the number of exit points that are
+   --  not blocked by unconditional transfer instructions (for IF and CASE,
+   --  these are the branches of the conditional, for a block, they are the
+   --  statement sequence of the block, and the statement sequences of any
+   --  exception handlers that are part of the block. When processing is
+   --  complete, if this count is zero, it means that control cannot fall
+   --  through the IF, CASE or block statement. This is used for the
+   --  generation of warning messages. This variable is recursively saved
+   --  on entry to processing the construct, and restored on exit.
 
    -----------------------
    -- Local Subprograms --
@@ -514,18 +517,47 @@ package body Sem_Ch5 is
    procedure Analyze_Block_Statement (N : Node_Id) is
       Decls : constant List_Id := Declarations (N);
       Id    : constant Node_Id := Identifier (N);
+      HSS   : constant Node_Id := Handled_Statement_Sequence (N);
+
+   begin
+      --  If no handled statement sequence is present, things are really
+      --  messed up, and we just return immediately (this is a defence
+      --  against previous errors).
+
+      if No (HSS) then
+         return;
+      end if;
+
+      --  Normal processing with HSS present
+
+      declare
+         EH  : constant List_Id := Exception_Handlers (HSS);
          Ent : Entity_Id        := Empty;
+         S   : Entity_Id;
+
+         Save_Unblocked_Exit_Count : constant Nat := Unblocked_Exit_Count;
+         --  Recursively save value of this global, will be restored on exit
 
       begin
+         --  Initialize unblocked exit count for statements of begin block
+         --  plus one for each excption handler that is present.
+
+         Unblocked_Exit_Count := 1;
+
+         if Present (EH) then
+            Unblocked_Exit_Count := Unblocked_Exit_Count + List_Length (EH);
+         end if;
+
          --  If a label is present analyze it and mark it as referenced
 
          if Present (Id) then
             Analyze (Id);
             Ent := Entity (Id);
 
-         --  An error defense. If we have an identifier, but no entity, then
-         --  something is wrong. If we have previous errors, then just remove
-         --  the identifier and continue, otherwise raise an exception.
+            --  An error defense. If we have an identifier, but no entity,
+            --  then something is wrong. If we have previous errors, then
+            --  just remove the identifier and continue, otherwise raise
+            --  an exception.
 
             if No (Ent) then
                if Total_Errors_Detected /= 0 then
@@ -562,22 +594,15 @@ package body Sem_Ch5 is
             Check_Completion;
          end if;
 
-      Analyze (Handled_Statement_Sequence (N));
-      Process_End_Label (Handled_Statement_Sequence (N), 'e', Ent);
-
-      --  Analyze exception handlers if present. Note that the test for
-      --  HSS being present is an error defence against previous errors.
-
-      if Present (Handled_Statement_Sequence (N))
-        and then Present (Exception_Handlers (Handled_Statement_Sequence (N)))
-      then
-         declare
-            S : Entity_Id := Scope (Ent);
+         Analyze (HSS);
+         Process_End_Label (HSS, 'e', Ent);
 
-         begin
-            --  Indicate that enclosing scopes contain a block with handlers.
-            --  Only non-generic scopes need to be marked.
+         --  If exception handlers are present, then we indicate that
+         --  enclosing scopes contain a block with handlers. We only
+         --  need to mark non-generic scopes.
 
+         if Present (EH) then
+            S := Scope (Ent);
             loop
                Set_Has_Nested_Block_With_Handler (S);
                exit when Is_Overloadable (S)
@@ -585,11 +610,18 @@ package body Sem_Ch5 is
                  or else Is_Generic_Unit (S);
                S := Scope (S);
             end loop;
-         end;
          end if;
 
          Check_References (Ent);
          End_Scope;
+
+         if Unblocked_Exit_Count = 0 then
+            Unblocked_Exit_Count := Save_Unblocked_Exit_Count;
+            Check_Unreachable_Code (N);
+         else
+            Unblocked_Exit_Count := Save_Unblocked_Exit_Count;
+         end if;
+      end;
    end Analyze_Block_Statement;
 
    ----------------------------
@@ -1557,7 +1589,15 @@ package body Sem_Ch5 is
          begin
             Nxt := Original_Node (Next (N));
 
-            if Present (Nxt)
+            --  If a label follows us, then we never have dead code, since
+            --  someone could branch to the label, so we just ignore it.
+
+            if Nkind (Nxt) = N_Label then
+               return;
+
+            --  Otherwise see if we have a real statement following us
+
+            elsif Present (Nxt)
               and then Comes_From_Source (Nxt)
               and then Is_Statement (Nxt)
             then
@@ -1613,28 +1653,53 @@ package body Sem_Ch5 is
 
             --  If the unconditional transfer of control instruction is
             --  the last statement of a sequence, then see if our parent
-            --  is an IF statement, and if so adjust the unblocked exit
-            --  count of the if statement to reflect the fact that this
-            --  branch of the if is indeed blocked by a transfer of control.
+            --  is one of the constructs for which we count unblocked exits,
+            --  and if so, adjust the count.
 
             else
                P := Parent (N);
 
+               --  Statements in THEN part or ELSE part of IF statement
+
                if Nkind (P) = N_If_Statement then
                   null;
 
+               --  Statements in ELSIF part of an IF statement
+
                elsif Nkind (P) = N_Elsif_Part then
                   P := Parent (P);
                   pragma Assert (Nkind (P) = N_If_Statement);
 
+               --  Statements in CASE statement alternative
+
                elsif Nkind (P) = N_Case_Statement_Alternative then
                   P := Parent (P);
                   pragma Assert (Nkind (P) = N_Case_Statement);
 
+               --  Statements in body of block
+
+               elsif Nkind (P) = N_Handled_Sequence_Of_Statements
+                 and then Nkind (Parent (P)) = N_Block_Statement
+               then
+                  null;
+
+               --  Statements in exception handler in a block
+
+               elsif Nkind (P) = N_Exception_Handler
+                 and then Nkind (Parent (P)) = N_Handled_Sequence_Of_Statements
+                 and then Nkind (Parent (Parent (P))) = N_Block_Statement
+               then
+                  null;
+
+               --  None of these cases, so return
+
                else
                   return;
                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;
             end if;
          end;