[multiple changes]

2012-06-12  Robert Dewar  <dewar@adacore.com>

	* stringt.adb: Minor reformatting.

2012-06-12  Robert Dewar  <dewar@adacore.com>

	* ali-util.adb, stringt.ads: Minor reformatting.

2012-06-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Process_Declarations): Handle the case where
	the original context has been wrapped in a block to avoid
	interference between exception handlers and At_End handlers.
	(Wrap_HSS_In_Block): Mark the block which contains the original
	statements of the context as being a finalization wrapper.
	* sinfo.adb (Is_Finalization_Wrapper): New routine.
	(Set_Is_Finalization_Wrapper): New routine.

	* sinfo.ads: Add new attribute Is_Finalization_Wrapper applicable
	to block statemnts.
	(Is_Finalization_Wrapper): New routine with corresponding pragma Inline.
	(Set_Is_Finalization_Wrapper): New routine with corresponding pragma
	Inline.

2012-06-12  Steve Baird  <baird@adacore.com>

	* gnat1drv.adb (Adjust_Global_Switches): No longer need to set
	Exception_Extra_Info in CodePeer_Mode.

From-SVN: r188449

8 files changed, 89 insertions, 12 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 90bb9bb..5944186 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,34 @@
 2012-06-12  Robert Dewar  <dewar@adacore.com>
 
+	* stringt.adb: Minor reformatting.
+
+2012-06-12  Robert Dewar  <dewar@adacore.com>
+
+	* ali-util.adb, stringt.ads: Minor reformatting.
+
+2012-06-12  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch7.adb (Process_Declarations): Handle the case where
+	the original context has been wrapped in a block to avoid
+	interference between exception handlers and At_End handlers.
+	(Wrap_HSS_In_Block): Mark the block which contains the original
+	statements of the context as being a finalization wrapper.
+	* sinfo.adb (Is_Finalization_Wrapper): New routine.
+	(Set_Is_Finalization_Wrapper): New routine.
+
+	* sinfo.ads: Add new attribute Is_Finalization_Wrapper applicable
+	to block statemnts.
+	(Is_Finalization_Wrapper): New routine with corresponding pragma Inline.
+	(Set_Is_Finalization_Wrapper): New routine with corresponding pragma
+	Inline.
+
+2012-06-12  Steve Baird  <baird@adacore.com>
+
+	* gnat1drv.adb (Adjust_Global_Switches): No longer need to set
+	Exception_Extra_Info in CodePeer_Mode.
+
+2012-06-12  Robert Dewar  <dewar@adacore.com>
+
 	* sem_dist.adb, exp_ch7.adb, sem_type.adb, exp_attr.adb,
 	sinfo.ads, sem_ch7.adb, exp_alfa.adb, sem_scil.adb, sem_ch12.adb,
 	sem_util.adb, sem_res.adb, sem_attr.adb, sem_elab.adb, exp_ch6.adb,
diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb
index 40cb1d9..0c2e87d 100644
--- a/gcc/ada/ali-util.adb
+++ b/gcc/ada/ali-util.adb
@@ -475,7 +475,9 @@ package body ALI.Util is
             --  of the source file in the table if checksums match.
 
             --  ??? It is probably worth updating the ALI file with a new
-            --  field to avoid recomputing it each time.
+            --  field to avoid recomputing it each time. In any case we ensure
+            --  that we don't gobble up string table space by doing a mark
+            --  release around this computation.
 
             Stringt.Mark;
 
@@ -495,7 +497,6 @@ package body ALI.Util is
             end if;
 
             Stringt.Release;
-
          end if;
 
          if (not Read_Only) or else Source.Table (Src).Source_Found then
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 1ffc8ca..0352fe2 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2094,6 +2094,22 @@ package body Exp_Ch7 is
                then
                   Last_Top_Level_Ctrl_Construct := Decl;
                end if;
+
+            --  Handle the case where the original context has been wrapped in
+            --  a block to avoid interference between exception handlers and
+            --  At_End handlers. Treat the block as transparent and process its
+            --  contents.
+
+            elsif Nkind (Decl) = N_Block_Statement
+              and then Is_Finalization_Wrapper (Decl)
+            then
+               if Present (Handled_Statement_Sequence (Decl)) then
+                  Process_Declarations
+                    (Statements (Handled_Statement_Sequence (Decl)),
+                     Preprocess);
+               end if;
+
+               Process_Declarations (Declarations (Decl), Preprocess);
             end if;
 
             Prev_Non_Pragma (Decl);
@@ -3696,6 +3712,11 @@ package body Exp_Ch7 is
            Make_Block_Statement (Loc,
              Handled_Statement_Sequence => HSS);
 
+         --  Signal the finalization machinery that this particular block
+         --  contains the original context.
+
+         Set_Is_Finalization_Wrapper (Block);
+
          Set_Handled_Statement_Sequence (N,
            Make_Handled_Sequence_Of_Statements (Loc, New_List (Block)));
          HSS := Handled_Statement_Sequence (N);
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index a3ed807..57aacca 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -265,12 +265,6 @@ procedure Gnat1drv is
 
          Force_ALI_Tree_File := True;
          Try_Semantics := True;
-
-         --  Enable Exception_Extra_Info for now, to avoid extra messages
-         --  on controlled operations.
-         --  ??? To be revised.
-
-         Exception_Extra_Info := True;
       end if;
 
       --  Set Configurable_Run_Time mode if system.ads flag set
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index e7ad52e..9c6b688 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -1806,6 +1806,14 @@ package body Sinfo is
       return Flag11 (N);
    end Is_Expanded_Build_In_Place_Call;
 
+   function Is_Finalization_Wrapper
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Block_Statement);
+      return Flag9 (N);
+   end Is_Finalization_Wrapper;
+
    function Is_Folded_In_Parser
       (N : Node_Id) return Boolean is
    begin
@@ -4902,6 +4910,14 @@ package body Sinfo is
       Set_Flag11 (N, Val);
    end Set_Is_Expanded_Build_In_Place_Call;
 
+   procedure Set_Is_Finalization_Wrapper
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Block_Statement);
+      Set_Flag9 (N, Val);
+   end Set_Is_Finalization_Wrapper;
+
    procedure Set_Is_Folded_In_Parser
       (N : Node_Id; Val : Boolean := True) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 22aea5b..7620449 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1310,6 +1310,12 @@ package Sinfo is
    --    actuals to support a build-in-place style of call have been added to
    --    the call.
 
+   --  Is_Finalization_Wrapper (Flag9-Sem);
+   --    This flag is present in N_Block_Statement nodes. It is set when the
+   --    block acts as a wrapper of a handled construct which has controlled
+   --    objects. The wrapper prevents interference between exception handlers
+   --    and At_End handlers.
+
    --  Is_In_Discriminant_Check (Flag11-Sem)
    --    This flag is present in a selected component, and is used to indicate
    --    that the reference occurs within a discriminant check. The
@@ -4331,6 +4337,7 @@ package Sinfo is
       --  Is_Task_Allocation_Block (Flag6)
       --  Is_Asynchronous_Call_Block (Flag7)
       --  Exception_Junk (Flag8-Sem)
+      --  Is_Finalization_Wrapper (Flag9-Sem)
 
       -------------------------
       -- 5.7  Exit Statement --
@@ -8670,6 +8677,9 @@ package Sinfo is
    function Is_Expanded_Build_In_Place_Call
      (N : Node_Id) return Boolean;    -- Flag11
 
+   function Is_Finalization_Wrapper
+     (N : Node_Id) return Boolean;    -- Flag9
+
    function Is_Folded_In_Parser
      (N : Node_Id) return Boolean;    -- Flag4
 
@@ -9657,6 +9667,9 @@ package Sinfo is
    procedure Set_Is_Expanded_Build_In_Place_Call
      (N : Node_Id; Val : Boolean := True);    -- Flag11
 
+   procedure Set_Is_Finalization_Wrapper
+     (N : Node_Id; Val : Boolean := True);    -- Flag9
+
    procedure Set_Is_Folded_In_Parser
      (N : Node_Id; Val : Boolean := True);    -- Flag4
 
@@ -12014,6 +12027,7 @@ package Sinfo is
    pragma Inline (Is_Elsif);
    pragma Inline (Is_Entry_Barrier_Function);
    pragma Inline (Is_Expanded_Build_In_Place_Call);
+   pragma Inline (Is_Finalization_Wrapper);
    pragma Inline (Is_Folded_In_Parser);
    pragma Inline (Is_In_Discriminant_Check);
    pragma Inline (Is_Machine_Number);
@@ -12338,6 +12352,7 @@ package Sinfo is
    pragma Inline (Set_Is_Elsif);
    pragma Inline (Set_Is_Entry_Barrier_Function);
    pragma Inline (Set_Is_Expanded_Build_In_Place_Call);
+   pragma Inline (Set_Is_Finalization_Wrapper);
    pragma Inline (Set_Is_Folded_In_Parser);
    pragma Inline (Set_Is_In_Discriminant_Check);
    pragma Inline (Set_Is_Machine_Number);
diff --git a/gcc/ada/stringt.adb b/gcc/ada/stringt.adb
index 8d3b2da..c0ec2f1 100644
--- a/gcc/ada/stringt.adb
+++ b/gcc/ada/stringt.adb
@@ -70,7 +70,7 @@ package body Stringt is
    --  when Start_String is called with a parameter that is the last string
    --  currently allocated in the table.
 
-   Strings_Last : String_Id := First_String_Id;
+   Strings_Last      : String_Id := First_String_Id;
    String_Chars_Last : Int := 0;
    --  Strings_Last and String_Chars_Last are used by procedure Mark and
    --  Release to get a snapshot of the tables and to restore them to their
diff --git a/gcc/ada/stringt.ads b/gcc/ada/stringt.ads
index 7fb4725..7f96df0 100644
--- a/gcc/ada/stringt.ads
+++ b/gcc/ada/stringt.ads
@@ -63,12 +63,13 @@ package Stringt is
    --  Unlock internal tables, in case back end needs to modify them
 
    procedure Mark;
-   --  Take a snapshot of the internal tables
+   --  Take a snapshot of the internal tables. Used in conjunction with Release
+   --  when computing temporary string values that need not be preserved.
 
    procedure Release;
    --  Restore the internal tables to the situation when Mark was last called.
-   --  Mark and Release are used when getting checksums of sources in minimal
-   --  recompilation mode, to reduce memory usage.
+   --  If Release is called with no prior call to Mark, the entire string table
+   --  is cleared to its initial (empty) setting.
 
    procedure Start_String;
    --  Sets up for storing a new string in the table. To store a string, a