From 25b589cbd523d5b7ccf42c7807f9cac86879008d Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 29 Aug 2011 10:40:53 +0200 Subject: [PATCH] [multiple changes] 2011-08-29 Hristian Kirtchev * 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 * sinfo.ads, sinfo.adb (Zero_Cost_Handling): Remove. (Set_Zero_Cost_Handling): Remove. 2011-08-29 Thomas Quinot * par_sco.adb, scos.ads, put_scos.adb, get_scos.adb: Minor reformatting From-SVN: r178162 --- gcc/ada/ChangeLog | 16 ++++++++++++++++ gcc/ada/exp_util.adb | 26 ++++++++++++++++++++------ gcc/ada/get_scos.adb | 2 +- gcc/ada/par_sco.adb | 2 +- gcc/ada/put_scos.adb | 2 +- gcc/ada/scos.ads | 33 ++++++++++++++++++--------------- gcc/ada/sinfo.adb | 18 ------------------ gcc/ada/sinfo.ads | 18 ------------------ 8 files changed, 57 insertions(+), 60 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3079b209b72..8e50a827d97 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2011-08-29 Hristian Kirtchev + + * 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 + + * sinfo.ads, sinfo.adb (Zero_Cost_Handling): Remove. + (Set_Zero_Cost_Handling): Remove. + +2011-08-29 Thomas Quinot + + * par_sco.adb, scos.ads, put_scos.adb, get_scos.adb: Minor reformatting + 2011-08-29 Geert Bosch * s-vaflop-vms-alpha.adb (Neg_F): Use subtraction instead of negation diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index d4f8954c3b4..a5faf484b26 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -5483,9 +5483,17 @@ package body Exp_Util is 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 | @@ -5500,8 +5508,10 @@ package body Exp_Util is 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 @@ -5515,8 +5525,10 @@ package body Exp_Util is 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 | @@ -5532,8 +5544,10 @@ package body Exp_Util is 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 => diff --git a/gcc/ada/get_scos.adb b/gcc/ada/get_scos.adb index e9c17bd07aa..b3957ecbb68 100644 --- a/gcc/ada/get_scos.adb +++ b/gcc/ada/get_scos.adb @@ -307,7 +307,7 @@ begin -- Decision entry - when 'I' | 'E' | 'G' | 'P' | 'W' | 'X' => + when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' => Dtyp := C; Skip_Spaces; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index a38da051d8b..c2aab468f98 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -1423,7 +1423,7 @@ package body Par_SCO is -- 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); diff --git a/gcc/ada/put_scos.adb b/gcc/ada/put_scos.adb index 65dfbc80046..a1b3f231564 100644 --- a/gcc/ada/put_scos.adb +++ b/gcc/ada/put_scos.adb @@ -156,7 +156,7 @@ begin -- 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 diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads index 61a675856b9..d8ab7a82b2b 100644 --- a/gcc/ada/scos.ads +++ b/gcc/ada/scos.ads @@ -152,7 +152,6 @@ package SCOs is -- 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) @@ -227,15 +226,15 @@ package SCOs is -- 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 @@ -388,10 +387,16 @@ package SCOs is -- 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 @@ -402,14 +407,12 @@ package SCOs is -- 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' diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 73b848946f2..11e8aa05c63 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -3103,15 +3103,6 @@ package body Sinfo is 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 -- -------------------------- @@ -6153,15 +6144,6 @@ package body Sinfo is 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 -- ------------------------- diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index eca688af230..eb9b4764dfa 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1806,14 +1806,6 @@ package Sinfo is -- 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 -- -------------------------------------------------- @@ -5957,7 +5949,6 @@ package Sinfo is -- 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 @@ -5983,7 +5974,6 @@ package Sinfo is -- 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) @@ -9001,9 +8991,6 @@ package Sinfo is 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) ---------------------------- @@ -9973,9 +9960,6 @@ package Sinfo is 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 -- ------------------------- @@ -12037,7 +12021,6 @@ package Sinfo is 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); @@ -12357,7 +12340,6 @@ package Sinfo is pragma Inline (Set_Used_Operations); pragma Inline (Set_Was_Originally_Stub); pragma Inline (Set_Withed_Body); - pragma Inline (Set_Zero_Cost_Handling); -------------- -- Synonyms --