[PATCH] PR ada/66242 Front-end error if exception propagation disabled

[PATCH] PR ada/66242 Front-end error if exception propagation disabled

[Simon Wright]

[-- Attachment #1: Type: text/plain, Size: 1623 bytes --]

There are two issues in code expansion related to Ada.Finalization that aren’t properly handled in the presence of pragma Restriction (No_Exception_Propagation).

The expanded code attempts to catch any exception propagated during Finalize and record that it happened, and later, if there was a caught exception, raise Program_Error instead.

Given No_Exception_Propagation, this fails because no exception could have been propagated from Finalize in the first place, so Exp_Ch7.Build_Object_Declarations detects that No_Exception_Propagation is in force and omits the creation of the temporary variable which would have recorded the propagation.

The attached patch modifies the two compiler source files affected and adds a new test case. Patched 5.1.0 code, bootstrap and regression test on x86_64-apple-darwin13. The patches apply to trunk with minor offsets.

gcc/ada/Changelog:

2015–6-14  Simon Wright <simon@pushface.org

        PR ada/66242
        * exp_ch7.adb (Process_Transient_Objects): new constant Exceptions_OK.
        If exceptions aren't OK, build Fin_Block without wrapping the Stmts
        in an exception handler.
        At end, only Build_Raise_Statement if exceptions are OK.
        * exp_intr.adb (Expand_Unc_Deallocation): if exceptions aren't
        being propagated, build Final_Code without including any exception
        handler.
        Don't append a raise statement if exceptions aren't being
        propagated.

gcc/testsuite/Changelog:

2015–6-14  Simon Wright <simon@pushface.org

        PR ada/66242
        * gnat.dg/finalization.ad[sb]: new.



[-- Attachment #2: pr66242.diff --]
[-- Type: application/octet-stream, Size: 5841 bytes --]

diff -r 241625079f4f gcc/ada/exp_ch7.adb
--- a/gcc/ada/exp_ch7.adb	Sat Apr 25 16:51:45 2015 +0100
+++ b/gcc/ada/exp_ch7.adb	Sun Jun 14 17:23:38 2015 +0100
@@ -4612,6 +4612,9 @@
          --  Flag denoting whether the context requires transient variable
          --  export to the outer finalizer.
 
+         Exceptions_OK : constant Boolean :=
+                           not Restriction_Active (No_Exception_Propagation);
+
          function Is_Subprogram_Call (N : Node_Id) return Traverse_Result;
          --  Determine whether an arbitrary node denotes a subprogram call
 
@@ -4890,13 +4893,22 @@
                --          end if;
                --    end;
 
-               Fin_Block :=
-                 Make_Block_Statement (Loc,
-                   Handled_Statement_Sequence =>
-                     Make_Handled_Sequence_Of_Statements (Loc,
-                       Statements => Stmts,
-                       Exception_Handlers => New_List (
-                         Build_Exception_Handler (Fin_Data))));
+               if Exceptions_OK then
+                  Fin_Block :=
+                    Make_Block_Statement (Loc,
+                      Handled_Statement_Sequence =>
+                        Make_Handled_Sequence_Of_Statements (Loc,
+                          Statements => Stmts,
+                          Exception_Handlers => New_List (
+                            Build_Exception_Handler (Fin_Data))));
+               else
+                  Fin_Block :=
+                    Make_Block_Statement (Loc,
+                      Handled_Statement_Sequence =>
+                        Make_Handled_Sequence_Of_Statements (Loc,
+                          Statements => Stmts,
+                          Exception_Handlers => New_List));
+               end if;
 
                --  The single raise statement must be inserted after all the
                --  finalization blocks, and we put everything into a wrapper
@@ -4941,7 +4953,7 @@
          --       Raise_From_Controlled_Operation (E);
          --    end if;
 
-         if Built and then Present (Last_Fin) then
+         if Exceptions_OK and then Built and then Present (Last_Fin) then
             Insert_After_And_Analyze (Last_Fin,
               Build_Raise_Statement (Fin_Data));
          end if;
diff -r 241625079f4f gcc/ada/exp_intr.adb
--- a/gcc/ada/exp_intr.adb	Sat Apr 25 16:51:45 2015 +0100
+++ b/gcc/ada/exp_intr.adb	Sun Jun 14 17:23:38 2015 +0100
@@ -1060,14 +1060,24 @@
 
          Build_Object_Declarations (Finalizer_Data, Stmts, Loc);
 
-         Final_Code := New_List (
-           Make_Block_Statement (Loc,
-             Handled_Statement_Sequence =>
-               Make_Handled_Sequence_Of_Statements (Loc,
-                 Statements         => New_List (
-                   Make_Final_Call (Obj_Ref => Deref, Typ => Desig_T)),
-                 Exception_Handlers => New_List (
-                   Build_Exception_Handler (Finalizer_Data)))));
+         if not Restriction_Active (No_Exception_Propagation) then
+            Final_Code := New_List (
+              Make_Block_Statement (Loc,
+                Handled_Statement_Sequence =>
+                  Make_Handled_Sequence_Of_Statements (Loc,
+                    Statements         => New_List (
+                      Make_Final_Call (Obj_Ref => Deref, Typ => Desig_T)),
+                    Exception_Handlers => New_List (
+                      Build_Exception_Handler (Finalizer_Data)))));
+         else
+            Final_Code := New_List (
+              Make_Block_Statement (Loc,
+                Handled_Statement_Sequence =>
+                  Make_Handled_Sequence_Of_Statements (Loc,
+                    Statements         => New_List (
+                      Make_Final_Call (Obj_Ref => Deref, Typ => Desig_T)),
+                    Exception_Handlers => New_List)));
+         end if;
 
          --  For .NET/JVM, detach the object from the containing finalization
          --  collection before finalizing it.
@@ -1328,7 +1338,9 @@
       --       Raise_From_Controlled_Operation (E);  --  all other cases
       --    end if;
 
-      if Needs_Fin then
+      if Needs_Fin
+        and then not Restriction_Active (No_Exception_Propagation)
+      then
          Append_To (Stmts, Build_Raise_Statement (Finalizer_Data));
       end if;
 
diff -r 241625079f4f gcc/testsuite/gnat.dg/finalization.adb
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/gnat.dg/finalization.adb	Sun Jun 14 17:23:38 2015 +0100
@@ -0,0 +1,35 @@
+-- { dg-do compile }
+
+with Ada.Unchecked_Deallocation;
+package body Finalization is
+   procedure Fin_Deallocation is
+
+      type F_P is access F;
+      procedure Delete
+        is new Ada.Unchecked_Deallocation (F, F_P);
+
+      procedure Check_Heap_1 is
+         An_F_P : F_P :=
+           new F'(Ada.Finalization.Controlled with null record);
+      begin
+         Delete (An_F_P);
+      end Check_Heap_1;
+
+   begin
+      Check_Heap_1;
+   end Fin_Deallocation;
+
+   procedure Fin_Return_Controlled is
+      type R is record
+         A, B : F;
+      end record;
+      function Get_F return R is
+      begin
+         return (A => F'(Ada.Finalization.Controlled with null record),
+                 B => F'(Ada.Finalization.Controlled with null record));
+      end Get_F;
+      An_F : R;
+   begin
+      An_F := Get_F;
+   end Fin_Return_Controlled;
+end Finalization;
diff -r 241625079f4f gcc/testsuite/gnat.dg/finalization.ads
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/gnat.dg/finalization.ads	Sun Jun 14 17:23:38 2015 +0100
@@ -0,0 +1,6 @@
+pragma Restrictions (No_Exception_Propagation);
+with Ada.Finalization;
+package Finalization is
+   pragma Elaborate_Body;
+   type F is new Ada.Finalization.Controlled with null record;
+end Finalization;

[-- Attachment #3: Type: text/plain, Size: 2 bytes --]

Re: [PATCH] PR ada/66242 Front-end error if exception propagation disabled

[Arnaud Charlet]

Simon,

As discussed privately, your patch is interesting but isn't complete enough
so cannot be integrated as is since we also want to avoid not only the
generation of the initialization/finalization exception handlers, but also
to eliminate the creation of the various variables that keep track of this
process as well as the removal of the now redundant wrapper blocks.

We'll possibly make a more complete patch in this area in the future that
will address this PR, so if you're not in a hurry, I would suggest you
keep your local patch for now.

Arno