[multiple changes]

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

From-SVN: r178162

gcc/ada/ChangeLog

@@ -1,3 +1,19 @@
+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

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 (
+               Block := Wrap_Statements_In_Block (Then_Statements (N));
-                 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 (
+               Block := Wrap_Statements_In_Block (Else_Statements (N));
-                 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 (
+               Block := Wrap_Statements_In_Block (Statements (N));
-                 Wrap_Statements_In_Block (Statements (N))));
+               Set_Statements (N, New_List (Block));
+
+               Analyze (Block);
             end if;
 
          when others                       =>

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;
 

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);

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

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,
+   --    For E, G, I, P, W, sloc is the source location of the EXIT, ENTRY, IF,
-   --    ENTRY, PRAGMA or WHILE token, respectively
+   --    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)
+   --    Note: for a pragma that may be disabled (Debug, Assert, PPC, Check),
-   --      C1   = 'I'/'E'/'W' (for IF/EXIT/WHILE)
+   --    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
+   --    Note: when the parse tree is first scanned, we unconditionally build a
-   --      a pragma decision entry for any decision in a pragma (here as always
+   --    pragma decision entry for any decision in a pragma (here as always in
-   --      in SCO contexts, the only pragmas with decisions are Assert, Check,
+   --    SCO contexts, the only pragmas with decisions are Assert, Check,
-   --      dyadic Debug, Precondition and Postcondition).
+   --    dyadic Debug, Precondition and Postcondition). These entries will
-   --
+   --    be omitted in output if the pragma is disabled (see comments for
-   --      During analysis, if the pragma is enabled, Set_SCO_Pragma_Enabled
+   --    statement entries).
-   --      marks the statement SCO table entry as enaabled (C1 changed from 'p'
-   --      to 'P') to cause the entry to be emitted in Put_SCOs.
 
    --    Decision (Expression)
    --      C1   = 'X'

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 --
    -------------------------

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 --