+ -------------------------------------
+ -- Raise_From_Controlled_Operation --
+ -------------------------------------
+
+ procedure Raise_From_Controlled_Operation
+ (X : Ada.Exceptions.Exception_Occurrence)
+ is
+ Prefix : constant String := "adjust/finalize raised ";
+ Orig_Msg : constant String := Exception_Message (X);
+ New_Msg : constant String := Prefix & Exception_Name (X);
+
+ begin
+ if Orig_Msg'Length >= Prefix'Length
+ and then
+ Orig_Msg (Orig_Msg'First .. Orig_Msg'First + Prefix'Length - 1) =
+ Prefix
+ then
+ -- Message already has proper prefix, just re-reraise PROGRAM_ERROR
+
+ Raise_Exception_No_Defer
+ (E => Program_Error'Identity,
+ Message => Orig_Msg);
+
+ elsif Orig_Msg = "" then
+
+ -- No message present: just provide our own
+
+ Raise_Exception_No_Defer
+ (E => Program_Error'Identity,
+ Message => New_Msg);
+
+ else
+ -- Message present, add informational prefix
+
+ Raise_Exception_No_Defer
+ (E => Program_Error'Identity,
+ Message => New_Msg & ": " & Orig_Msg);
+ end if;
+ end Raise_From_Controlled_Operation;
+