diff --git a/scripts/ci-github.sh b/scripts/ci-github.sh index 1318c169d..400905ab4 100755 --- a/scripts/ci-github.sh +++ b/scripts/ci-github.sh @@ -72,6 +72,10 @@ $run_pip install --upgrade -r requirements.txt echo Python search paths: $run_python -c "import sys; print('\n'.join(sys.path))" +echo Check Finalize exception handling : +$run_python ../scripts/python/check_finalize_exceptions.py ../src +echo ............................ + echo Running test suite now: $run_python ./run.py -E || { echo Test suite failures, unstable build!; exit 1; } cd .. diff --git a/scripts/python/check_finalize_exceptions.py b/scripts/python/check_finalize_exceptions.py new file mode 100755 index 000000000..92363557e --- /dev/null +++ b/scripts/python/check_finalize_exceptions.py @@ -0,0 +1,40 @@ +#!/usr/bin/env python3 +# Find all Finalize procedures that do not report unhandled exceptions + +import re +import glob +import sys + + +def find_matching(source_file, match_pattern, exclude_pattern): + match_re = re.compile(match_pattern) + exclude_re = re.compile(exclude_pattern) + + count = 0 + with open(source_file, "r", encoding="utf-8") as file: + previous_line = "" + line_nbr = 1 + for line in file: + if match_re.search(line) and not exclude_re.search(previous_line): + print(f"{source_file}:{line_nbr}: " + line) + count = count + 1 + previous_line = line + line_nbr = line_nbr + 1 + + return count > 0 + + +if __name__ == "__main__": + if len(sys.argv) != 2: + print("Please provide one directory path") + sys.exit(1) + + count = 0 + for file in glob.glob(f"{sys.argv[1]}/**/*.ad[bs]"): + if find_matching( + file, ".*end Finalize;.*", ".*Alire.Utils.Finalize_Exception.*" + ): + count = count + 1 + + if count > 0: + sys.exit(1) diff --git a/src/alire/alire-directories.adb b/src/alire/alire-directories.adb index 51413aa6c..a5c3f8e24 100644 --- a/src/alire/alire-directories.adb +++ b/src/alire/alire-directories.adb @@ -1,6 +1,5 @@ with AAA.Directories; -with Ada.Exceptions; with Ada.Numerics.Discrete_Random; with Ada.Real_Time; with Ada.Unchecked_Conversion; @@ -11,6 +10,7 @@ with Alire.Paths; with Alire.Platforms.Current; with Alire.Platforms.Folders; with Alire.VFS; +with Alire.Utils; with GNAT.String_Hash; @@ -490,7 +490,6 @@ package body Alire.Directories is overriding procedure Finalize (This : in out Guard) is use Ada.Directories; - use Ada.Exceptions; use Ada.Strings.Unbounded; procedure Free is new Ada.Unchecked_Deallocation (Absolute_Path, Destination); @@ -506,10 +505,7 @@ package body Alire.Directories is Free (Freeable); exception when E : others => - Trace.Debug - ("FG.Finalize: unexpected exception: " & - Exception_Name (E) & ": " & Exception_Message (E) & " -- " & - Exception_Information (E)); + Alire.Utils.Finalize_Exception (E); end Finalize; ------------------ @@ -760,8 +756,7 @@ package body Alire.Directories is exception when E : others => - Log_Exception (E); - raise; + Alire.Utils.Finalize_Exception (E); end Finalize; -------------------- diff --git a/src/alire/alire-errors.adb b/src/alire/alire-errors.adb index 4913ffe0d..4cf4adde9 100644 --- a/src/alire/alire-errors.adb +++ b/src/alire/alire-errors.adb @@ -1,4 +1,5 @@ with Ada.Containers.Indefinite_Ordered_Maps; +with Alire.Utils; package body Alire.Errors is @@ -209,6 +210,9 @@ package body Alire.Errors is pragma Unreferenced (This); begin Close; + exception + when E : others => + Alire.Utils.Finalize_Exception (E); end Finalize; ----------- diff --git a/src/alire/alire-roots-editable.adb b/src/alire/alire-roots-editable.adb index 4902edca1..bb59bd76b 100644 --- a/src/alire/alire-roots-editable.adb +++ b/src/alire/alire-roots-editable.adb @@ -523,6 +523,9 @@ package body Alire.Roots.Editable is Trace.Debug ("Discarding temporary root file: " & File); end; end if; + exception + when E : others => + Alire.Utils.Finalize_Exception (E); end Finalize; begin @@ -530,7 +533,7 @@ package body Alire.Roots.Editable is Finalize (+This.Edit.Lockfile); exception when E : others => - Log_Exception (E, Warning); + Alire.Utils.Finalize_Exception (E); end Finalize; --------- diff --git a/src/alire/alire-roots.adb b/src/alire/alire-roots.adb index 3269d6fe7..463d7ab45 100644 --- a/src/alire/alire-roots.adb +++ b/src/alire/alire-roots.adb @@ -2020,6 +2020,9 @@ package body Alire.Roots is (Crate_Configuration.Global_Config, Global_Config_Access); begin Free (This.Configuration); + exception + when E : others => + Alire.Utils.Finalize_Exception (E); end Finalize; end Alire.Roots; diff --git a/src/alire/alire-toml_adapters.adb b/src/alire/alire-toml_adapters.adb index d0660cdfe..3bf67cc61 100644 --- a/src/alire/alire-toml_adapters.adb +++ b/src/alire/alire-toml_adapters.adb @@ -1,3 +1,5 @@ +with Alire.Utils; + package body Alire.TOML_Adapters is -------------- @@ -10,6 +12,10 @@ package body Alire.TOML_Adapters is begin -- Manually close this error scope Errors.Close; + + exception + when E : others => + Alire.Utils.Finalize_Exception (E); end Finalize; ------------ diff --git a/src/alire/alire-utils-text_files.adb b/src/alire/alire-utils-text_files.adb index 358c2b87f..a014b6aa9 100644 --- a/src/alire/alire-utils-text_files.adb +++ b/src/alire/alire-utils-text_files.adb @@ -46,6 +46,10 @@ package body Alire.Utils.Text_Files is Close (File); Replacer.Replace; end; + + exception + when E : others => + Alire.Utils.Finalize_Exception (E); end Finalize; ----------- diff --git a/src/alire/alire-utils.adb b/src/alire/alire-utils.adb index 1f8efb48f..1b48243d8 100644 --- a/src/alire/alire-utils.adb +++ b/src/alire/alire-utils.adb @@ -253,4 +253,23 @@ package body Alire.Utils is end if; end Image_Keys_One_Line; + ------------------------ + -- Finalize_Exception -- + ------------------------ + + procedure Finalize_Exception (E : Ada.Exceptions.Exception_Occurrence) is + + -- Import a Last_Chance_Handler procedure that will either be the one + -- declared by Alr, or the default GNAT last chance handler. + + procedure Last_Chance_Handler (E : Ada.Exceptions.Exception_Occurrence); + pragma Import (C, + Last_Chance_Handler, + "__gnat_last_chance_handler"); + pragma No_Return (Last_Chance_Handler); + + begin + Last_Chance_Handler (E); + end Finalize_Exception; + end Alire.Utils; diff --git a/src/alire/alire-utils.ads b/src/alire/alire-utils.ads index 4b26227a4..4cf70f10b 100644 --- a/src/alire/alire-utils.ads +++ b/src/alire/alire-utils.ads @@ -84,6 +84,27 @@ package Alire.Utils with Preelaborate is -- Flatten String keys of Indefinite_Ordered_Maps into string -- representation. + procedure Finalize_Exception (E : Ada.Exceptions.Exception_Occurrence); + -- Every controlled object Finalize procedure must call this function to + -- report unhandled exceptions. + -- + -- Ada exceptions are not propagated outside the Finalize procedure. + -- Instead, another exception is raise with the message "finalize/adjust + -- raised exception". Alire is using exceptions to report meaningfull error + -- messages to the user. If one of these exception is raised in a Finalize + -- procedure, the error message will vanish and the user will only see + -- "finalize/adjust raised exception". + -- + -- For this reason, it is important to catch all exceptions before reaching + -- the end of Finalize and use this Finalize_Exception procedure to display + -- a meaningful error message. + -- + -- Use the following code at the end of every Finalize procedures: + -- exception + -- when E : others => + -- Alire.Utils.Finalize_Exception (E); + -- end Finalize; + private function Quote (S : String) return String diff --git a/src/alr/alr-commands-dev.adb b/src/alr/alr-commands-dev.adb index 4b84110f4..e58627303 100644 --- a/src/alr/alr-commands-dev.adb +++ b/src/alr/alr-commands-dev.adb @@ -1,6 +1,8 @@ with Ada.Strings.UTF_Encoding.Wide_Wide_Strings; +with Ada.Finalization; with Alire.Selftest; +with Alire.Utils; package body Alr.Commands.Dev is @@ -24,6 +26,28 @@ package body Alr.Commands.Dev is Trace.Always (Encode ("ⓘ✓")); end Print_UTF_8_Sequence; + ----------------------------- + -- Raise_From_Finalization -- + ----------------------------- + + procedure Raise_From_Finalization is + type Ctrl is new Ada.Finalization.Controlled with null record; + + overriding + procedure Finalize (This : in out Ctrl) is + begin + raise Program_Error with "Raising forcibly from finalization"; + exception + when E : others => + Alire.Utils.Finalize_Exception (E); + end Finalize; + + Test : Ctrl; + pragma Unreferenced (Test); + begin + null; + end Raise_From_Finalization; + ------------- -- Execute -- ------------- @@ -49,6 +73,10 @@ package body Alr.Commands.Dev is raise Program_Error with "Raising forcibly"; end if; + if Cmd.Raise_Final then + Raise_From_Finalization; + end if; + if Cmd.Self_Test then Alire.Selftest.Run; end if; @@ -96,6 +124,11 @@ package body Alr.Commands.Dev is "", "--raise", "Raise an exception"); + Define_Switch (Config, + Cmd.Raise_Final'Access, + "", "--raise-finalization", + "Raise an exception from a finalization procedure"); + Define_Switch (Config, Cmd.Self_Test'Access, "", "--test", diff --git a/src/alr/alr-commands-dev.ads b/src/alr/alr-commands-dev.ads index b83011bf5..3ca5591e7 100644 --- a/src/alr/alr-commands-dev.ads +++ b/src/alr/alr-commands-dev.ads @@ -35,6 +35,7 @@ private Custom : aliased Boolean := False; -- Custom code to run instead Filtering : aliased Boolean := False; -- Runs debug scope filtering Raise_Except : aliased Boolean := False; + Raise_Final : aliased Boolean := False; Self_Test : aliased Boolean := False; UTF_8_Test : aliased Boolean := False; -- Produce some UTF-8 output end record; diff --git a/src/alr/alr-utils-temp_file.adb b/src/alr/alr-utils-temp_file.adb index b82663279..7f29dbdaf 100644 --- a/src/alr/alr-utils-temp_file.adb +++ b/src/alr/alr-utils-temp_file.adb @@ -14,6 +14,10 @@ package body Alr.Utils.Temp_File is Delete_File (This.Name); null; end if; + + exception + when E : others => + Alire.Utils.Finalize_Exception (E); end Finalize; -------------- diff --git a/testsuite/tests/debug/enabled-dump-exception/test.py b/testsuite/tests/debug/enabled-dump-exception/test.py index 460bb7f13..6ff88037a 100644 --- a/testsuite/tests/debug/enabled-dump-exception/test.py +++ b/testsuite/tests/debug/enabled-dump-exception/test.py @@ -28,4 +28,9 @@ def check_output(dump): "ERROR: Raising forcibly\n" "ERROR: alr encountered an unexpected error, re-run with -d for details.\n") +# Check exception from finalization : +assert_eq(run_alr('dev', '--raise-finalization', debug=False, complain_on_error=False).out, + "ERROR: Raising forcibly from finalization\n" + "ERROR: alr encountered an unexpected error, re-run with -d for details.\n") + print('SUCCESS')