+2011-08-29 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_util.adb (Process_Statements_For_Controlled_Objects): Whenever a
+ statement list is wrapped in a block, the block is explicitly analyzed
+ in order to properly redecorate the entities and create a servicing
+ finalizer.
+
+2011-08-29 Tristan Gingold <gingold@adacore.com>
+
+ * sinfo.ads, sinfo.adb (Zero_Cost_Handling): Remove.
+ (Set_Zero_Cost_Handling): Remove.
+
+2011-08-29 Thomas Quinot <quinot@adacore.com>
+
+ * par_sco.adb, scos.ads, put_scos.adb, get_scos.adb: Minor reformatting
+
2011-08-29 Geert Bosch <bosch@adacore.com>
* s-vaflop-vms-alpha.adb (Neg_F): Use subtraction instead of negation
Statements => L));
end Wrap_Statements_In_Block;
+ -- Local variables
+
+ Block : Node_Id;
+
-- Start of processing for Process_Statements_For_Controlled_Objects
begin
+ -- Whenever a non-handled statement list is wrapped in a block, the
+ -- block must be explicitly analyzed to redecorate all entities in the
+ -- list and ensure that a finalizer is properly built.
+
case Nkind (N) is
when N_Elsif_Part |
N_If_Statement |
and then Requires_Cleanup_Actions
(Then_Statements (N), False, False)
then
- Set_Then_Statements (N, New_List (
- Wrap_Statements_In_Block (Then_Statements (N))));
+ Block := Wrap_Statements_In_Block (Then_Statements (N));
+ Set_Then_Statements (N, New_List (Block));
+
+ Analyze (Block);
end if;
-- Check the "else statements" for conditional entry calls, if
and then Requires_Cleanup_Actions
(Else_Statements (N), False, False)
then
- Set_Else_Statements (N, New_List (
- Wrap_Statements_In_Block (Else_Statements (N))));
+ Block := Wrap_Statements_In_Block (Else_Statements (N));
+ Set_Else_Statements (N, New_List (Block));
+
+ Analyze (Block);
end if;
when N_Abortable_Part |
and then not Are_Wrapped (Statements (N))
and then Requires_Cleanup_Actions (Statements (N), False, False)
then
- Set_Statements (N, New_List (
- Wrap_Statements_In_Block (Statements (N))));
+ Block := Wrap_Statements_In_Block (Statements (N));
+ Set_Statements (N, New_List (Block));
+
+ Analyze (Block);
end if;
when others =>
-- Decision entry
- when 'I' | 'E' | 'G' | 'P' | 'W' | 'X' =>
+ when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
Dtyp := C;
Skip_Spaces;
-- Output for disabled pragmas is suppressed later
-- on, when we output the decision line in
-- Put_SCOs, depending on marker sets by
- -- Set_SCO_Pragma_Disabled.
+ -- Set_SCO_Pragma_Enabled.
if Nam = Name_Check then
Next (Arg);
-- Decision
- when 'I' | 'E' | 'G' | 'P' | 'W' | 'X' =>
+ when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
Start := Start + 1;
-- For disabled pragma, or nested decision therein, skip
-- E EXIT statement
-- F FOR loop statement (from FOR through end of iteration scheme)
-- I IF statement (from IF through end of condition)
- -- p disabled PRAGMA
-- P PRAGMA
-- R extended RETURN statement
-- W WHILE loop statement (from WHILE through end of condition)
-- Here * is one of the following characters:
- -- I decision in IF statement or conditional expression
-- E decision in EXIT WHEN statement
-- G decision in entry guard
+ -- I decision in IF statement or conditional expression
-- P decision in pragma Assert/Check/Pre_Condition/Post_Condition
-- W decision in WHILE iteration scheme
-- X decision appearing in some other expression context
- -- For I, E, G, P, W, sloc is the source location of the IF, EXIT,
- -- ENTRY, PRAGMA or WHILE token, respectively
+ -- For E, G, I, P, W, sloc is the source location of the EXIT, ENTRY, IF,
+ -- PRAGMA or WHILE token, respectively
-- For X, sloc is omitted
-- statements on a single CS line (possibly followed by Cs continuation
-- lines).
- -- Decision (IF/EXIT/WHILE)
- -- C1 = 'I'/'E'/'W' (for IF/EXIT/WHILE)
+ -- Note: for a pragma that may be disabled (Debug, Assert, PPC, Check),
+ -- the entry is initially created with C2 = 'p', to mark it as disabled.
+ -- Later on during semantic analysis, if the pragma is enabled,
+ -- Set_SCO_Pragma_Enabled changes C2 to 'P' to cause the entry to be
+ -- emitted in Put_SCOs.
+
+ -- Decision (EXIT/entry guard/IF/WHILE)
+ -- C1 = 'E'/'G'/'I'/'W' (for EXIT/entry Guard/IF/WHILE)
-- C2 = ' '
- -- From = IF/EXIT/WHILE token
+ -- From = EXIT/ENTRY/IF/WHILE token
-- To = No_Source_Location
-- Last = unused
-- To = No_Source_Location
-- Last = unused
- -- Note: when the parse tree is first scanned, we unconditionally build
- -- a pragma decision entry for any decision in a pragma (here as always
- -- in SCO contexts, the only pragmas with decisions are Assert, Check,
- -- dyadic Debug, Precondition and Postcondition).
- --
- -- During analysis, if the pragma is enabled, Set_SCO_Pragma_Enabled
- -- marks the statement SCO table entry as enaabled (C1 changed from 'p'
- -- to 'P') to cause the entry to be emitted in Put_SCOs.
+ -- Note: when the parse tree is first scanned, we unconditionally build a
+ -- pragma decision entry for any decision in a pragma (here as always in
+ -- SCO contexts, the only pragmas with decisions are Assert, Check,
+ -- dyadic Debug, Precondition and Postcondition). These entries will
+ -- be omitted in output if the pragma is disabled (see comments for
+ -- statement entries).
-- Decision (Expression)
-- C1 = 'X'
return Node1 (N);
end Withed_Body;
- function Zero_Cost_Handling
- (N : Node_Id) return Boolean is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Exception_Handler
- or else NT (N).Nkind = N_Handled_Sequence_Of_Statements);
- return Flag5 (N);
- end Zero_Cost_Handling;
-
--------------------------
-- Field Set Procedures --
--------------------------
Set_Node1 (N, Val);
end Set_Withed_Body;
- procedure Set_Zero_Cost_Handling
- (N : Node_Id; Val : Boolean := True) is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Exception_Handler
- or else NT (N).Nkind = N_Handled_Sequence_Of_Statements);
- Set_Flag5 (N, Val);
- end Set_Zero_Cost_Handling;
-
-------------------------
-- Iterator Procedures --
-------------------------
-- library unit of the with_clause and as a result loads its body.
-- Used for a more precise unit traversal for CodePeer.
- -- Zero_Cost_Handling (Flag5-Sem)
- -- This flag is set in all handled sequence of statement and exception
- -- handler nodes if exceptions are to be handled using the zero-cost
- -- mechanism (see Ada.Exceptions and System.Exceptions in files
- -- a-except.ads/adb and s-except.ads for full details). What gigi needs
- -- to do for such a handler is simply to put the code in the handler
- -- somewhere. The front end has generated all necessary labels.
-
--------------------------------------------------
-- Note on Use of End_Label and End_Span Fields --
--------------------------------------------------
-- Exception_Handlers (List5) (set to No_List if none present)
-- At_End_Proc (Node1) (set to Empty if no clean up procedure)
-- First_Real_Statement (Node2-Sem)
- -- Zero_Cost_Handling (Flag5-Sem)
-- Note: the parent always contains a Declarations field which contains
-- declarations associated with the handled sequence of statements. This
-- Exception_Choices (List4)
-- Statements (List3)
-- Exception_Label (Node5-Sem) (set to Empty of not present)
- -- Zero_Cost_Handling (Flag5-Sem)
-- Local_Raise_Statements (Elist1-Sem) (set to No_Elist if not present)
-- Local_Raise_Not_OK (Flag7-Sem)
-- Has_Local_Raise (Flag8-Sem)
function Withed_Body
(N : Node_Id) return Node_Id; -- Node1
- function Zero_Cost_Handling
- (N : Node_Id) return Boolean; -- Flag5
-
-- End functions (note used by xsinfo utility program to end processing)
----------------------------
procedure Set_Withed_Body
(N : Node_Id; Val : Node_Id); -- Node1
- procedure Set_Zero_Cost_Handling
- (N : Node_Id; Val : Boolean := True); -- Flag5
-
-------------------------
-- Iterator Procedures --
-------------------------
pragma Inline (Used_Operations);
pragma Inline (Was_Originally_Stub);
pragma Inline (Withed_Body);
- pragma Inline (Zero_Cost_Handling);
pragma Inline (Set_ABE_Is_Certain);
pragma Inline (Set_Abort_Present);
pragma Inline (Set_Used_Operations);
pragma Inline (Set_Was_Originally_Stub);
pragma Inline (Set_Withed_Body);
- pragma Inline (Set_Zero_Cost_Handling);
--------------
-- Synonyms --
OSDN Git Service
