https://gcc.gnu.org/g:8e22376d8e2f2dd97e364aaf81a2b4260847e308
commit r15-559-g8e22376d8e2f2dd97e364aaf81a2b4260847e308
Author: Eric Botcazou <ebotca...@adacore.com>
Date: Fri Feb 23 21:55:08 2024 +0100
ada: Propagate Program_Error from failed finalization of collection
This aligns finalization collections with finalization masters when it comes
to propagating an exception raised by the finalization of a specific object,
by always propagating Program_Error instead of the aforementioned exception.
gcc/ada/
* libgnat/s-finpri.adb (Raise_From_Controlled_Operation): New
declaration of imported procedure moved from...
(Finalize_Master): ...there.
(Finalize): Call Raise_From_Controlled_Operation instead of
Reraise_Occurrence to propagate the exception, if any.
Diff:
---
gcc/ada/libgnat/s-finpri.adb | 12 ++++++------
1 file changed, 6 insertions(+), 6 deletions(-)
diff --git a/gcc/ada/libgnat/s-finpri.adb b/gcc/ada/libgnat/s-finpri.adb
index bd70e582de3d..89f5f2952e45 100644
--- a/gcc/ada/libgnat/s-finpri.adb
+++ b/gcc/ada/libgnat/s-finpri.adb
@@ -37,6 +37,10 @@ with System.Soft_Links; use System.Soft_Links;
package body System.Finalization_Primitives is
+ procedure Raise_From_Controlled_Operation (X : Exception_Occurrence);
+ pragma Import (Ada, Raise_From_Controlled_Operation,
+ "__gnat_raise_from_controlled_operation");
+
function To_Collection_Node_Ptr is
new Ada.Unchecked_Conversion (Address, Collection_Node_Ptr);
@@ -297,7 +301,7 @@ package body System.Finalization_Primitives is
-- If one of the finalization actions raised an exception, reraise it
if Finalization_Exception_Raised then
- Reraise_Occurrence (Exc_Occur);
+ Raise_From_Controlled_Operation (Exc_Occur);
end if;
end Finalize;
@@ -306,12 +310,8 @@ package body System.Finalization_Primitives is
---------------------
procedure Finalize_Master (Master : in out Finalization_Master) is
- procedure Raise_From_Controlled_Operation (X : Exception_Occurrence);
- pragma Import (Ada, Raise_From_Controlled_Operation,
- "__gnat_raise_from_controlled_operation");
-
- Finalization_Exception_Raised : Boolean := False;
Exc_Occur : Exception_Occurrence;
+ Finalization_Exception_Raised : Boolean := False;
Node : Master_Node_Ptr;
begin
