exp_ch7.adb (Expand_Cleanup_Actions): If statement sequence of construct is rewritten...

* exp_ch7.adb (Expand_Cleanup_Actions): If statement sequence of
	construct is rewritten, preserve end label to permit source navigation.

From-SVN: r91883
This commit is contained in:
Arnaud Charlet 2004-12-08 12:45:51 +01:00
parent 98f01d532a
commit 1453276224
1 changed files with 10 additions and 4 deletions

View File

@ -507,7 +507,7 @@ package body Exp_Ch7 is
-- of a single component of the array.
function Free_One_Dimension (Dim : Int) return List_Id;
-- Generate a loop over one dimension of the array.
-- Generate a loop over one dimension of the array
--------------------
-- Free_Component --
@ -721,7 +721,7 @@ package body Exp_Ch7 is
Next_Entity (E);
end loop;
-- Analyze inserted cleanup statements.
-- Analyze inserted cleanup statements
if Present (Stmt) then
Stmt := Next (Stmt);
@ -1106,6 +1106,7 @@ package body Exp_Ch7 is
Mark : Entity_Id := Empty;
New_Decls : constant List_Id := New_List;
Blok : Node_Id;
End_Lab : Node_Id;
Wrapped : Boolean;
Chain : Entity_Id := Empty;
Decl : Node_Id;
@ -1233,11 +1234,16 @@ package body Exp_Ch7 is
-- exception handlers and an AT END call in the same scope.
if Present (Exception_Handlers (Handled_Statement_Sequence (N))) then
-- Preserve end label to provide proper cross-reference information
End_Lab := End_Label (Handled_Statement_Sequence (N));
Blok :=
Make_Block_Statement (Loc,
Handled_Statement_Sequence => Handled_Statement_Sequence (N));
Set_Handled_Statement_Sequence (N,
Make_Handled_Sequence_Of_Statements (Loc, New_List (Blok)));
Set_End_Label (Handled_Statement_Sequence (N), End_Lab);
Wrapped := True;
-- Otherwise we do not wrap
@ -1306,7 +1312,7 @@ package body Exp_Ch7 is
Set_Declarations (N, New_Decls);
Analyze_Declarations (New_Decls);
-- The At_End call is attached to the sequence of statements.
-- The At_End call is attached to the sequence of statements
declare
HSS : Node_Id;
@ -2140,7 +2146,7 @@ package body Exp_Ch7 is
-- NOTE: This cleanup handler references _object, a parameter
-- to the procedure.
-- Find the _object parameter representing the protected object.
-- Find the _object parameter representing the protected object
Spec := Parent (Corresponding_Spec (N));