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 --git a/gcc/ada/libgnat/s-finpri.adb b/gcc/ada/libgnat/s-finpri.adb
index bd70e582de3d87d631f3329c5b5b8ba253a38f49..89f5f2952e4587f811c10cbdb1ddf02ee07fd5a3 100644 (file)
--- 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