diff options
author | Jedidiah Barber <contact@jedbarber.id.au> | 2025-01-09 23:53:32 +1300 |
---|---|---|
committer | Jedidiah Barber <contact@jedbarber.id.au> | 2025-01-09 23:53:32 +1300 |
commit | 53aa8144851913994b963ed611cca8885b8f9a9e (patch) | |
tree | 1b2a262cedb353b4aff00e14b200918ac17b11ab | |
parent | 17473af7e8ed13e0a9399a69442f9839e5d83aef (diff) |
Internal_FLTK_Error raises are now pragma Asserts
-rw-r--r-- | src/fltk-asks.adb | 47 | ||||
-rw-r--r-- | src/fltk-devices-surface-paged-postscript.adb | 17 | ||||
-rw-r--r-- | src/fltk-devices-surface-paged.adb | 18 | ||||
-rw-r--r-- | src/fltk-draw.adb | 35 | ||||
-rw-r--r-- | src/fltk-environment.adb | 13 | ||||
-rw-r--r-- | src/fltk-file_choosers.adb | 21 | ||||
-rw-r--r-- | src/fltk-filenames.adb | 52 | ||||
-rw-r--r-- | src/fltk-widgets-groups-browsers-textline-file.adb | 12 | ||||
-rw-r--r-- | src/fltk-widgets-groups-browsers-textline.adb | 54 | ||||
-rw-r--r-- | src/fltk-widgets-groups-browsers.adb | 48 | ||||
-rw-r--r-- | src/fltk-widgets-groups-help_views.adb | 12 |
11 files changed, 200 insertions, 129 deletions
diff --git a/src/fltk-asks.adb b/src/fltk-asks.adb index eba4dbb..bd09fac 100644 --- a/src/fltk-asks.adb +++ b/src/fltk-asks.adb @@ -6,6 +6,7 @@ with + Ada.Assertions, Interfaces.C.Strings; use type @@ -17,6 +18,11 @@ use type package body FLTK.Asks is + package Chk renames Ada.Assertions; + + + + ------------------------ -- Functions From C -- ------------------------ @@ -393,11 +399,10 @@ package body FLTK.Asks is Interfaces.C.Strings.Null_Ptr, Interfaces.C.Strings.Null_Ptr); begin - case Result is - when -3 .. -1 => return Extended_Choice_Result'Val (Result + 6); - when 0 .. 2 => return Extended_Choice_Result'Val (Result); - when others => raise Internal_FLTK_Error; - end case; + pragma Assert (Result in -3 .. 2); + return Extended_Choice_Result'Val (Result mod 6); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Extended_Choice; @@ -412,11 +417,10 @@ package body FLTK.Asks is Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access), Interfaces.C.Strings.Null_Ptr); begin - case Result is - when -3 .. -1 => return Extended_Choice_Result'Val (Result + 6); - when 0 .. 2 => return Extended_Choice_Result'Val (Result); - when others => raise Internal_FLTK_Error; - end case; + pragma Assert (Result in -3 .. 2); + return Extended_Choice_Result'Val (Result mod 6); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Extended_Choice; @@ -432,11 +436,10 @@ package body FLTK.Asks is Interfaces.C.Strings.To_Chars_Ptr (Str2'Unchecked_Access), Interfaces.C.Strings.To_Chars_Ptr (Str3'Unchecked_Access)); begin - case Result is - when -3 .. -1 => return Extended_Choice_Result'Val (Result + 6); - when 0 .. 2 => return Extended_Choice_Result'Val (Result); - when others => raise Internal_FLTK_Error; - end case; + pragma Assert (Result in -3 .. 2); + return Extended_Choice_Result'Val (Result mod 6); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Extended_Choice; @@ -504,11 +507,12 @@ package body FLTK.Asks is G := RGB_Float (C_G); B := RGB_Float (C_B); return Confirm; - elsif Result = 0 then - return Cancel; else - raise Internal_FLTK_Error; + pragma Assert (Result = 0); + return Cancel; end if; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Color_Chooser; @@ -531,11 +535,12 @@ package body FLTK.Asks is G := RGB_Int (C_G); B := RGB_Int (C_B); return Confirm; - elsif Result = 0 then - return Cancel; else - raise Internal_FLTK_Error; + pragma Assert (Result = 0); + return Cancel; end if; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Color_Chooser; diff --git a/src/fltk-devices-surface-paged-postscript.adb b/src/fltk-devices-surface-paged-postscript.adb index 92653cb..fa9f66d 100644 --- a/src/fltk-devices-surface-paged-postscript.adb +++ b/src/fltk-devices-surface-paged-postscript.adb @@ -6,6 +6,7 @@ with + Ada.Assertions, Interfaces.C.Strings; use type @@ -16,6 +17,11 @@ use type package body FLTK.Devices.Surface.Paged.Postscript is + package Chk renames Ada.Assertions; + + + + ------------------------ -- Functions From C -- ------------------------ @@ -347,9 +353,9 @@ package body FLTK.Devices.Surface.Paged.Postscript is To_Cint (Format), To_Cint (Layout)); begin - if Code /= 0 then - raise Internal_FLTK_Error; - end if; + pragma Assert (Code = 0); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Start_Job; @@ -366,11 +372,12 @@ package body FLTK.Devices.Surface.Paged.Postscript is To_Cint (Layout)); begin case Code is - when 0 => null; when 1 => raise User_Cancel_Error; when 2 => raise File_Open_Error; - when others => raise Internal_FLTK_Error; + when others => pragma Assert (Code = 0); end case; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Start_Job; diff --git a/src/fltk-devices-surface-paged.adb b/src/fltk-devices-surface-paged.adb index 2fb6450..829974a 100644 --- a/src/fltk-devices-surface-paged.adb +++ b/src/fltk-devices-surface-paged.adb @@ -6,6 +6,7 @@ with + Ada.Assertions, Ada.Strings.Unbounded, Interfaces.C.Strings; @@ -18,7 +19,8 @@ use type package body FLTK.Devices.Surface.Paged is - package SU renames Ada.Strings.Unbounded; + package Chk renames Ada.Assertions; + package SU renames Ada.Strings.Unbounded; @@ -204,11 +206,12 @@ package body FLTK.Devices.Surface.Paged is begin if Value in Page_Format'Pos (A0) .. Page_Format'Pos (Envelope) then return Page_Format'Val (Value); - elsif Value = fl_page_format_media then - return Media; else - raise Internal_FLTK_Error; + pragma Assert (Value = fl_page_format_media); + return Media; end if; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end To_Page_Format; @@ -235,11 +238,12 @@ package body FLTK.Devices.Surface.Paged is return Landscape; elsif Value = fl_page_layout_reversed then return Reversed; - elsif Value = fl_page_layout_orientation then - return Orientation; else - raise Internal_FLTK_Error; + pragma Assert (Value = fl_page_layout_orientation); + return Orientation; end if; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end To_Page_Layout; diff --git a/src/fltk-draw.adb b/src/fltk-draw.adb index 42b3d26..79d34ff 100644 --- a/src/fltk-draw.adb +++ b/src/fltk-draw.adb @@ -6,6 +6,7 @@ with + Ada.Assertions, Ada.Unchecked_Deallocation, Interfaces.C.Strings; @@ -18,6 +19,15 @@ use type package body FLTK.Draw is + package Chk renames Ada.Assertions; + + + + + ------------------------ + -- Functions From C -- + ------------------------ + procedure fl_draw_reset_spot; pragma Import (C, fl_draw_reset_spot, "fl_draw_reset_spot"); pragma Inline (fl_draw_reset_spot); @@ -670,11 +680,12 @@ package body FLTK.Draw is begin if Result = 1 then return True; - elsif Result = 0 then - return False; else - raise Internal_FLTK_Error; + pragma Assert (Result = 0); + return False; end if; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Can_Do_Alpha_Blending; @@ -1214,10 +1225,10 @@ package body FLTK.Draw is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.int (Alpha)); - if Buffer /= Storage.To_Integer (Result (Result'First)'Address) then - raise Internal_FLTK_Error; - end if; + pragma Assert (Buffer = Storage.To_Integer (Result (Result'First)'Address)); return Result; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Read_Image; @@ -1239,9 +1250,11 @@ package body FLTK.Draw is begin if Ret_Val = 0 then raise Draw_Error; - elsif Ret_Val /= 1 then - raise Internal_FLTK_Error; + else + pragma Assert (Ret_Val = 1); end if; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Add_Symbol; procedure Draw_Text @@ -1406,9 +1419,11 @@ package body FLTK.Draw is begin if Ret_Val = 0 then raise Draw_Error; - elsif Ret_Val /= 1 then - raise Internal_FLTK_Error; + else + pragma Assert (Ret_Val = 1); end if; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Draw_Symbol; diff --git a/src/fltk-environment.adb b/src/fltk-environment.adb index a1ebdbe..22cf676 100644 --- a/src/fltk-environment.adb +++ b/src/fltk-environment.adb @@ -6,6 +6,7 @@ with + Ada.Assertions, Interfaces.C.Strings; use type @@ -17,6 +18,11 @@ use type package body FLTK.Environment is + package Chk renames Ada.Assertions; + + + + ------------------------ -- Constants From C -- ------------------------ @@ -381,11 +387,12 @@ package body FLTK.Environment is begin if Num = root_fl_prefs_system then return Global; - elsif Num = root_fl_prefs_user then - return User; else - raise Internal_FLTK_Error; + pragma Assert (Num = root_fl_prefs_user); + return User; end if; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end To_Scope; diff --git a/src/fltk-file_choosers.adb b/src/fltk-file_choosers.adb index 07c10b1..d413f15 100644 --- a/src/fltk-file_choosers.adb +++ b/src/fltk-file_choosers.adb @@ -6,6 +6,7 @@ with + Ada.Assertions, Interfaces.C.Strings, System.Address_To_Access_Conversions; @@ -18,6 +19,8 @@ use type package body FLTK.File_Choosers is + package Chk renames Ada.Assertions; + package File_Chooser_Convert is new System.Address_To_Access_Conversions (File_Chooser'Class); package Widget_Convert is new System.Address_To_Access_Conversions (Widgets.Widget'Class); @@ -1038,11 +1041,10 @@ package body FLTK.File_Choosers is is Ret : Interfaces.C.int := fl_file_chooser_get_preview (This.Void_Ptr); begin - if Ret not in 0 .. 1 then - raise Internal_FLTK_Error; - else - return Boolean'Val (Ret); - end if; + pragma Assert (Ret in 0 .. 1); + return Boolean'Val (Ret); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Has_Preview; @@ -1108,11 +1110,10 @@ package body FLTK.File_Choosers is is Ret : Interfaces.C.int := fl_file_chooser_get_type (This.Void_Ptr); begin - if Ret not in 0 .. Chooser_Kind'Pos (Chooser_Kind'Last) then - raise Internal_FLTK_Error; - else - return Chooser_Kind'Val (Ret); - end if; + pragma Assert (Ret in 0 .. Chooser_Kind'Pos (Chooser_Kind'Last)); + return Chooser_Kind'Val (Ret); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Get_Chooser_Kind; diff --git a/src/fltk-filenames.adb b/src/fltk-filenames.adb index f8f31f0..7674323 100644 --- a/src/fltk-filenames.adb +++ b/src/fltk-filenames.adb @@ -6,6 +6,7 @@ with + Ada.Assertions, Interfaces.C.Strings; use type @@ -17,6 +18,11 @@ use type package body FLTK.Filenames is + package Chk renames Ada.Assertions; + + + + ------------------------ -- Constants From C -- ------------------------ @@ -160,11 +166,11 @@ package body FLTK.Filenames is Result : Interfaces.C.int := filename_alphasort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); begin - if Result not in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last) then - raise Internal_FLTK_Error; - else - return Comparison'Val (Result); - end if; + pragma Assert + (Result in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last)); + return Comparison'Val (Result); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Alpha_Sort; @@ -175,11 +181,11 @@ package body FLTK.Filenames is Result : Interfaces.C.int := filename_casealphasort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); begin - if Result not in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last) then - raise Internal_FLTK_Error; - else - return Comparison'Val (Result); - end if; + pragma Assert + (Result in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last)); + return Comparison'Val (Result); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Case_Alpha_Sort; @@ -190,11 +196,11 @@ package body FLTK.Filenames is Result : Interfaces.C.int := filename_numericsort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); begin - if Result not in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last) then - raise Internal_FLTK_Error; - else - return Comparison'Val (Result); - end if; + pragma Assert + (Result in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last)); + return Comparison'Val (Result); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Numeric_Sort; @@ -205,11 +211,11 @@ package body FLTK.Filenames is Result : Interfaces.C.int := filename_casenumericsort (Interfaces.C.To_C (A), Interfaces.C.To_C (B)); begin - if Result not in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last) then - raise Internal_FLTK_Error; - else - return Comparison'Val (Result); - end if; + pragma Assert + (Result in Comparison'Pos (Comparison'First) .. Comparison'Pos (Comparison'Last)); + return Comparison'Val (Result); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Case_Numeric_Sort; @@ -276,9 +282,11 @@ package body FLTK.Filenames is begin if Result = 0 then raise Open_URI_Error with "Error: " & Interfaces.C.To_Ada (Message); - elsif Result /= 1 then - raise Internal_FLTK_Error; + else + pragma Assert (Result = 1); end if; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Open_URI; diff --git a/src/fltk-widgets-groups-browsers-textline-file.adb b/src/fltk-widgets-groups-browsers-textline-file.adb index c48e0be..bd7ce7f 100644 --- a/src/fltk-widgets-groups-browsers-textline-file.adb +++ b/src/fltk-widgets-groups-browsers-textline-file.adb @@ -6,6 +6,7 @@ with + Ada.Assertions, Interfaces.C.Strings; use type @@ -17,6 +18,11 @@ use type package body FLTK.Widgets.Groups.Browsers.Textline.File is + package Chk renames Ada.Assertions; + + + + ------------------------ -- Functions From C -- ------------------------ @@ -385,10 +391,10 @@ package body FLTK.Widgets.Groups.Browsers.Textline.File is is Code : Interfaces.C.int := fl_file_browser_get_filetype (This.Void_Ptr); begin - if Code not in File_Kind'Pos (File_Kind'First) .. File_Kind'Pos (File_Kind'Last) then - raise Internal_FLTK_Error; - end if; + pragma Assert (Code in File_Kind'Pos (File_Kind'First) .. File_Kind'Pos (File_Kind'Last)); return File_Kind'Val (Code); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Get_File_Kind; diff --git a/src/fltk-widgets-groups-browsers-textline.adb b/src/fltk-widgets-groups-browsers-textline.adb index 1e8988e..8c68420 100644 --- a/src/fltk-widgets-groups-browsers-textline.adb +++ b/src/fltk-widgets-groups-browsers-textline.adb @@ -6,6 +6,7 @@ with + Ada.Assertions, Ada.Unchecked_Deallocation, FLTK.Images, Interfaces.C.Strings; @@ -19,6 +20,11 @@ use type package body FLTK.Widgets.Groups.Browsers.Textline is + package Chk renames Ada.Assertions; + + + + ------------------------ -- Functions From C -- ------------------------ @@ -594,9 +600,11 @@ package body FLTK.Widgets.Groups.Browsers.Textline is else raise Browser_Load_Error with Interfaces.C.Strings.Value (Msg); end if; - elsif Code /= 1 then - raise Internal_FLTK_Error; + else + pragma Assert (Code = 1); end if; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Load; @@ -765,11 +773,10 @@ package body FLTK.Widgets.Groups.Browsers.Textline is Interfaces.C.int (Line), Boolean'Pos (State)); begin - if Code not in 0 .. 1 then - raise Internal_FLTK_Error; - else - return Boolean'Val (Code); - end if; + pragma Assert (Code in 0 .. 1); + return Boolean'Val (Code); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Set_Select; @@ -783,9 +790,9 @@ package body FLTK.Widgets.Groups.Browsers.Textline is Interfaces.C.int (Line), Boolean'Pos (State)); begin - if Code not in 0 .. 1 then - raise Internal_FLTK_Error; - end if; + pragma Assert (Code in 0 .. 1); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Set_Select; @@ -798,11 +805,10 @@ package body FLTK.Widgets.Groups.Browsers.Textline is (This.Void_Ptr, Interfaces.C.int (Line)); begin - if Code not in 0 .. 1 then - raise Internal_FLTK_Error; - else - return Boolean'Val (Code); - end if; + pragma Assert (Code in 0 .. 1); + return Boolean'Val (Code); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Is_Selected; @@ -842,11 +848,10 @@ package body FLTK.Widgets.Groups.Browsers.Textline is (This.Void_Ptr, Interfaces.C.int (Line)); begin - if Code not in 0 .. 1 then - raise Internal_FLTK_Error; - else - return Boolean'Val (Code); - end if; + pragma Assert (Code in 0 .. 1); + return Boolean'Val (Code); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Is_Displayed; @@ -1084,11 +1089,10 @@ package body FLTK.Widgets.Groups.Browsers.Textline is pragma Import (Ada, my_item_selected); Code : Interfaces.C.int := my_item_selected (This.Void_Ptr, Cursor_To_Address (Item)); begin - if Code not in 0 .. 1 then - raise Internal_FLTK_Error; - else - return Boolean'Val (Code); - end if; + pragma Assert (Code in 0 .. 1); + return Boolean'Val (Code); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Item_Selected; diff --git a/src/fltk-widgets-groups-browsers.adb b/src/fltk-widgets-groups-browsers.adb index 0c65653..aa717b7 100644 --- a/src/fltk-widgets-groups-browsers.adb +++ b/src/fltk-widgets-groups-browsers.adb @@ -6,6 +6,7 @@ with + Ada.Assertions, Interfaces.C.Strings, System.Address_To_Access_Conversions; @@ -13,6 +14,11 @@ with package body FLTK.Widgets.Groups.Browsers is + package Chk renames Ada.Assertions; + + + + ------------------------ -- Constants From C -- ------------------------ @@ -773,10 +779,10 @@ package body FLTK.Widgets.Groups.Browsers is Boolean'Pos (State), Boolean'Pos (Do_Callbacks)); begin - if Code not in 0 .. 1 then - raise Internal_FLTK_Error; - end if; + pragma Assert (Code in 0 .. 1); return Boolean'Val (Code); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Set_Select; @@ -792,9 +798,9 @@ package body FLTK.Widgets.Groups.Browsers is Boolean'Pos (State), Boolean'Pos (Do_Callbacks)); begin - if Code not in 0 .. 1 then - raise Internal_FLTK_Error; - end if; + pragma Assert (Code in 0 .. 1); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Set_Select; @@ -809,10 +815,10 @@ package body FLTK.Widgets.Groups.Browsers is Cursor_To_Address (Item), Boolean'Pos (Do_Callbacks)); begin - if Code not in 0 .. 1 then - raise Internal_FLTK_Error; - end if; + pragma Assert (Code in 0 .. 1); return Boolean'Val (Code); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Select_Only; @@ -826,9 +832,9 @@ package body FLTK.Widgets.Groups.Browsers is Cursor_To_Address (Item), Boolean'Pos (Do_Callbacks)); begin - if Code not in 0 .. 1 then - raise Internal_FLTK_Error; - end if; + pragma Assert (Code in 0 .. 1); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Select_Only; @@ -849,10 +855,10 @@ package body FLTK.Widgets.Groups.Browsers is (This.Void_Ptr, Boolean'Pos (Do_Callbacks)); begin - if Code not in 0 .. 1 then - raise Internal_FLTK_Error; - end if; + pragma Assert (Code in 0 .. 1); return Boolean'Val (Code); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Deselect; @@ -864,9 +870,9 @@ package body FLTK.Widgets.Groups.Browsers is (This.Void_Ptr, Boolean'Pos (Do_Callbacks)); begin - if Code not in 0 .. 1 then - raise Internal_FLTK_Error; - end if; + pragma Assert (Code in 0 .. 1); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Deselect; @@ -886,10 +892,10 @@ package body FLTK.Widgets.Groups.Browsers is Code : Interfaces.C.int := fl_abstract_browser_displayed (This.Void_Ptr, Cursor_To_Address (Item)); begin - if Code not in 0 .. 1 then - raise Internal_FLTK_Error; - end if; + pragma Assert (Code in 0 .. 1); return Boolean'Val (Code); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Is_Displayed; diff --git a/src/fltk-widgets-groups-help_views.adb b/src/fltk-widgets-groups-help_views.adb index 715e2ca..a5b169c 100644 --- a/src/fltk-widgets-groups-help_views.adb +++ b/src/fltk-widgets-groups-help_views.adb @@ -6,6 +6,7 @@ with + Ada.Assertions, Interfaces.C.Strings, System.Address_To_Access_Conversions; @@ -17,6 +18,11 @@ use type package body FLTK.Widgets.Groups.Help_Views is + package Chk renames Ada.Assertions; + + + + ------------------------ -- Functions From C -- ------------------------ @@ -422,9 +428,11 @@ package body FLTK.Widgets.Groups.Help_Views is begin if Code = -1 then raise Load_Help_Error; - elsif Code /= 0 then - raise Internal_FLTK_Error; + else + pragma Assert (Code = 0); end if; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Load; |