Patchwork [Ada] Finalization actions during abort

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 4, 2011, 7:45 a.m.
Message ID <20110804074529.GA30736@adacore.com>
Download mbox | patch
Permalink /patch/108360/
State New
Headers show

Comments

Arnaud Charlet - Aug. 4, 2011, 7:45 a.m.
This patch adds a guard to the mechanism which determines whether finalization
was triggered by an abort.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Build_Adjust_Or_Finalize_Statements): Update the comment
	on the generated code.
	(Build_Finalize_Statements): Update the comment on the generated code.
	(Build_Initialize_Statements): Update the comment on the generated code.
	(Build_Object_Declarations): Add local variable Result. The object
	declarations are now built in sequence.
	* rtsfind.ads: Add RE_Exception_Occurrence_Access to tables RE_Id and
	RE_Unit_Table.

Patch

Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb	(revision 177283)
+++ exp_ch7.adb	(working copy)
@@ -2897,6 +2897,7 @@ 
    is
       A_Expr : Node_Id;
       E_Decl : Node_Id;
+      Result : List_Id;
 
    begin
       if Restriction_Active (No_Exception_Propagation) then
@@ -2907,37 +2908,87 @@ 
       pragma Assert (Present (E_Id));
       pragma Assert (Present (Raised_Id));
 
-      --  Generate:
-      --    Exception_Identity (Get_Current_Excep.all.all) =
-      --      Standard'Abort_Signal'Identity;
+      Result := New_List;
 
+      --  In certain scenarios, finalization can be triggered by an abort. If
+      --  the finalization itself fails and raises an exception, the resulting
+      --  Program_Error must be supressed and replaced by an abort signal. In
+      --  order to detect this scenario, save the state of entry into the
+      --  finalization code.
+
       if Abort_Allowed then
-         A_Expr :=
-           Make_Op_Eq (Loc,
-             Left_Opnd =>
-               Make_Function_Call (Loc,
-                 Name =>
-                   New_Reference_To (RTE (RE_Exception_Identity), Loc),
-               Parameter_Associations => New_List (
-                 Make_Explicit_Dereference (Loc,
-                   Prefix =>
-                     Make_Function_Call (Loc,
-                       Name =>
-                         Make_Explicit_Dereference (Loc,
-                           Prefix =>
-                             New_Reference_To
-                               (RTE (RE_Get_Current_Excep), Loc)))))),
+         declare
+            Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'E');
 
-             Right_Opnd =>
-               Make_Attribute_Reference (Loc,
-                 Prefix =>
-                   New_Reference_To (Stand.Abort_Signal, Loc),
-                 Attribute_Name => Name_Identity));
+         begin
+            --  Generate:
+            --    Temp : constant Exception_Occurrence_Access :=
+            --             Get_Current_Excep.all;
+
+            Append_To (Result,
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Temp_Id,
+                Constant_Present => True,
+                Object_Definition =>
+                  New_Reference_To (RTE (RE_Exception_Occurrence_Access), Loc),
+                Expression =>
+                  Make_Function_Call (Loc,
+                    Name =>
+                      Make_Explicit_Dereference (Loc,
+                        Prefix =>
+                          New_Reference_To
+                            (RTE (RE_Get_Current_Excep), Loc)))));
+
+            --  Generate:
+            --    Temp /= null
+            --      and then Exception_Identity (Temp.all) =
+            --                 Standard'Abort_Signal'Identity;
+
+            A_Expr :=
+              Make_And_Then (Loc,
+                Left_Opnd =>
+                  Make_Op_Ne (Loc,
+                    Left_Opnd =>
+                      New_Reference_To (Temp_Id, Loc),
+                    Right_Opnd =>
+                      Make_Null (Loc)),
+
+                Right_Opnd =>
+                  Make_Op_Eq (Loc,
+                    Left_Opnd =>
+                      Make_Function_Call (Loc,
+                        Name =>
+                          New_Reference_To (RTE (RE_Exception_Identity), Loc),
+                        Parameter_Associations => New_List (
+                          Make_Explicit_Dereference (Loc,
+                            Prefix =>
+                              New_Reference_To (Temp_Id, Loc)))),
+
+                    Right_Opnd =>
+                      Make_Attribute_Reference (Loc,
+                        Prefix =>
+                          New_Reference_To (Stand.Abort_Signal, Loc),
+                        Attribute_Name => Name_Identity)));
+         end;
+
+      --  No abort
+
       else
          A_Expr := New_Reference_To (Standard_False, Loc);
       end if;
 
       --  Generate:
+      --    Abort_Id : constant Boolean := <A_Expr>;
+
+      Append_To (Result,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Abort_Id,
+          Constant_Present => True,
+          Object_Definition =>
+            New_Reference_To (Standard_Boolean, Loc),
+          Expression => A_Expr));
+
+      --  Generate:
       --    E_Id : Exception_Occurrence;
 
       E_Decl :=
@@ -2947,30 +2998,20 @@ 
             New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
       Set_No_Initialization (E_Decl);
 
-      return
-        New_List (
+      Append_To (Result, E_Decl);
 
-         --  Abort_Id
+      --  Generate:
+      --    Raised_Id : Boolean := False;
 
-          Make_Object_Declaration (Loc,
-            Defining_Identifier => Abort_Id,
-            Constant_Present => True,
-            Object_Definition =>
-              New_Reference_To (Standard_Boolean, Loc),
-            Expression => A_Expr),
+      Append_To (Result,
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Raised_Id,
+          Object_Definition =>
+            New_Reference_To (Standard_Boolean, Loc),
+          Expression =>
+            New_Reference_To (Standard_False, Loc)));
 
-         --  E_Id
-
-          E_Decl,
-
-         --  Raised_Id
-
-          Make_Object_Declaration (Loc,
-            Defining_Identifier => Raised_Id,
-            Object_Definition =>
-              New_Reference_To (Standard_Boolean, Loc),
-            Expression =>
-              New_Reference_To (Standard_False, Loc)));
+      return Result;
    end Build_Object_Declarations;
 
    ---------------------------
@@ -4600,9 +4641,12 @@ 
       --  controlled elements. Generate:
 
       --    declare
+      --       Temp   : constant Exception_Occurrence_Access :=
+      --                  Get_Current_Excep.all;
       --       Abort  : constant Boolean :=
-      --                  Exception_Identity (Get_Current_Excep.all) =
-      --                    Standard'Abort_Signal'Identity;
+      --                  Temp /= null
+      --                    and then Exception_Identity (Temp_Id.all) =
+      --                               Standard'Abort_Signal'Identity;
       --         <or>
       --       Abort  : constant Boolean := False;  --  no abort
 
@@ -4653,9 +4697,12 @@ 
       --             exception
       --                when others =>
       --                   declare
+      --                      Temp   : constant Exception_Occurrence_Access :=
+      --                                 Get_Current_Excep.all;
       --                      Abort  : constant Boolean :=
-      --                        Exception_Identity (Get_Current_Excep.all) =
-      --                          Standard'Abort_Signal'Identity;
+      --                        Temp /= null
+      --                          and then Exception_Identity (Temp_Id.all) =
+      --                                     Standard'Abort_Signal'Identity;
       --                        <or>
       --                      Abort  : constant Boolean := False; --  no abort
       --                      E      : Exception_Occurence;
@@ -5513,9 +5560,12 @@ 
       --  may have discriminants and contain variant parts. Generate:
 
       --    declare
+      --       Temp   : constant Exception_Occurrence_Access :=
+      --                  Get_Current_Excep.all;
       --       Abort  : constant Boolean :=
-      --                  Exception_Identity (Get_Current_Excep.all) =
-      --                    Standard'Abort_Signal'Identity;
+      --                  Temp /= null
+      --                    and then Exception_Identity (Temp_Id.all) =
+      --                               Standard'Abort_Signal'Identity;
       --         <or>
       --       Abort  : constant Boolean := False;  --  no abort
       --       E      : Exception_Occurence;
Index: rtsfind.ads
===================================================================
--- rtsfind.ads	(revision 177283)
+++ rtsfind.ads	(working copy)
@@ -504,6 +504,7 @@ 
      RE_Exception_Message,               -- Ada.Exceptions
      RE_Exception_Name_Simple,           -- Ada.Exceptions
      RE_Exception_Occurrence,            -- Ada.Exceptions
+     RE_Exception_Occurrence_Access,     -- Ada.Exceptions
      RE_Null_Id,                         -- Ada.Exceptions
      RE_Null_Occurrence,                 -- Ada.Exceptions
      RE_Poll,                            -- Ada.Exceptions
@@ -1682,6 +1683,7 @@ 
      RE_Exception_Message                => Ada_Exceptions,
      RE_Exception_Name_Simple            => Ada_Exceptions,
      RE_Exception_Occurrence             => Ada_Exceptions,
+     RE_Exception_Occurrence_Access      => Ada_Exceptions,
      RE_Null_Id                          => Ada_Exceptions,
      RE_Null_Occurrence                  => Ada_Exceptions,
      RE_Poll                             => Ada_Exceptions,