[COMMITTED,20/31] ada: Fix abort deferral for finally parts

Message ID 20250107125350.619654-20-poulhies@adacore.com
State New
Headers
Series [COMMITTED,01/31] ada: Restrict previous change made to expansion of allocators |

Commit Message

Marc Poulhiès Jan. 7, 2025, 12:53 p.m. UTC
  From: Ronan Desplanques <desplanques@adacore.com>

This patch fixes two problems with how abort was deferred in finally
parts. First, calls to runtime subprograms are now omitted when
aborting is disallowed by active restrictions. Second, Abort_Undefer is
now correctly called when the finally part propagates an exception.

gcc/ada/ChangeLog:

	* exp_ch11.adb (Expand_N_Handled_Sequence_Of_Statements): Fix abort
	deferral.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch11.adb | 27 +++++++++++++++++++--------
 1 file changed, 19 insertions(+), 8 deletions(-)
  

Patch

diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index 66f38671008..189e0911fc4 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -1302,14 +1302,25 @@  package body Exp_Ch11 is
          Expand_Cleanup_Actions (Parent (N));
       end if;
 
-      if Present (Finally_Statements (N)) then
-         Prepend_To
-           (Finally_Statements (N),
-            Build_Runtime_Call (Sloc (N), RE_Abort_Defer));
-
-         Append_To
-           (Finally_Statements (N),
-            Build_Runtime_Call (Sloc (N), RE_Abort_Undefer));
+      if Present (Finally_Statements (N)) and then Abort_Allowed then
+         if Exceptions_OK then
+            Set_Finally_Statements
+              (N,
+               New_List
+                 (Build_Runtime_Call (Sloc (N), RE_Abort_Defer),
+                  Build_Abort_Undefer_Block
+                    (Sloc (N),
+                     Stmts   => Finally_Statements (N),
+                     Context => N)));
+         else
+            Prepend_To
+              (Finally_Statements (N),
+               Build_Runtime_Call (Sloc (N), RE_Abort_Defer));
+
+            Append_To
+              (Finally_Statements (N),
+               Build_Runtime_Call (Sloc (N), RE_Abort_Undefer));
+         end if;
 
          Analyze_List (Finally_Statements (N));
       end if;