diff options
32 files changed, 104 insertions, 72 deletions
diff --git a/src/fltk-images-rgb-png.adb b/src/fltk-images-rgb-png.adb index ecb2f5e..f6d9870 100644 --- a/src/fltk-images-rgb-png.adb +++ b/src/fltk-images-rgb-png.adb @@ -23,12 +23,13 @@ package body FLTK.Images.RGB.PNG is overriding procedure Finalize (This : in out PNG_Image) is begin - Finalize (RGB_Image (This)); - if This.Void_Ptr /= System.Null_Address then - if This in PNG_Image then - free_fl_png_image (This.Void_Ptr); - end if; + if This.Void_Ptr /= System.Null_Address and then + This in PNG_Image'Class + then + free_fl_png_image (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; + Finalize (RGB_Image (This)); end Finalize; diff --git a/src/fltk-images.adb b/src/fltk-images.adb index bbd87c9..d719e9c 100644 --- a/src/fltk-images.adb +++ b/src/fltk-images.adb @@ -38,12 +38,13 @@ package body FLTK.Images is overriding procedure Finalize (This : in out Image) is begin - Finalize (Wrapper (This)); - if This.Void_Ptr /= System.Null_Address then - if This in Image then - free_fl_image (This.Void_Ptr); - end if; + if This.Void_Ptr /= System.Null_Address and then + This in Image'Class + then + free_fl_image (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; + Finalize (Wrapper (This)); end Finalize; diff --git a/src/fltk-text_buffers.adb b/src/fltk-text_buffers.adb index 52f12e0..086ec03 100644 --- a/src/fltk-text_buffers.adb +++ b/src/fltk-text_buffers.adb @@ -138,10 +138,11 @@ package body FLTK.Text_Buffers is procedure Finalize (This : in out Text_Buffer) is begin - if This.Void_Ptr /= System.Null_Address then - if This in Text_Buffer then - free_fl_text_buffer (This.Void_Ptr); - end if; + if This.Void_Ptr /= System.Null_Address and then + This in Text_Buffer'Class + then + free_fl_text_buffer (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; end Finalize; diff --git a/src/fltk-widgets-boxes.adb b/src/fltk-widgets-boxes.adb index 1c8fa5b..ed61168 100644 --- a/src/fltk-widgets-boxes.adb +++ b/src/fltk-widgets-boxes.adb @@ -58,10 +58,11 @@ package body FLTK.Widgets.Boxes is procedure Finalize (This : in out Box) is begin - if This in Box and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Box'Class then free_fl_box (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-enter.adb b/src/fltk-widgets-buttons-enter.adb index d9575ca..6d8e796 100644 --- a/src/fltk-widgets-buttons-enter.adb +++ b/src/fltk-widgets-buttons-enter.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Buttons.Enter is procedure Finalize (This : in out Enter_Button) is begin - if This in Enter_Button and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Enter_Button'Class then free_fl_return_button (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-light-check.adb b/src/fltk-widgets-buttons-light-check.adb index c906a6c..4a1bcdb 100644 --- a/src/fltk-widgets-buttons-light-check.adb +++ b/src/fltk-widgets-buttons-light-check.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Buttons.Light.Check is procedure Finalize (This : in out Check_Button) is begin - if This in Check_Button and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Check_Button'Class then free_fl_check_button (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Light_Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-light-radio.adb b/src/fltk-widgets-buttons-light-radio.adb index c04d628..11c2b35 100644 --- a/src/fltk-widgets-buttons-light-radio.adb +++ b/src/fltk-widgets-buttons-light-radio.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Buttons.Light.Radio is procedure Finalize (This : in out Radio_Light_Button) is begin - if This in Radio_Light_Button and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Radio_Light_Button'Class then free_fl_radio_light_button (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Light_Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-light-round-radio.adb b/src/fltk-widgets-buttons-light-round-radio.adb index 8c95122..1e9b854 100644 --- a/src/fltk-widgets-buttons-light-round-radio.adb +++ b/src/fltk-widgets-buttons-light-round-radio.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Buttons.Light.Round.Radio is procedure Finalize (This : in out Radio_Round_Button) is begin - if This in Radio_Round_Button and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Radio_Round_Button'Class then free_fl_radio_round_button (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Round_Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-light-round.adb b/src/fltk-widgets-buttons-light-round.adb index 769f556..6e66b2c 100644 --- a/src/fltk-widgets-buttons-light-round.adb +++ b/src/fltk-widgets-buttons-light-round.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Buttons.Light.Round is procedure Finalize (This : in out Round_Button) is begin - if This in Round_Button and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Round_Button'Class then free_fl_round_button (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Light_Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-light.adb b/src/fltk-widgets-buttons-light.adb index e3b1cfd..77b8ee1 100644 --- a/src/fltk-widgets-buttons-light.adb +++ b/src/fltk-widgets-buttons-light.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Buttons.Light is procedure Finalize (This : in out Light_Button) is begin - if This in Light_Button and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Light_Button'Class then free_fl_light_button (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-radio.adb b/src/fltk-widgets-buttons-radio.adb index 2b932c3..25fedc0 100644 --- a/src/fltk-widgets-buttons-radio.adb +++ b/src/fltk-widgets-buttons-radio.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Buttons.Radio is procedure Finalize (This : in out Radio_Button) is begin - if This in Radio_Button and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Radio_Button'Class then free_fl_radio_button (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-repeat.adb b/src/fltk-widgets-buttons-repeat.adb index 7d0f0bd..8e7c9f3 100644 --- a/src/fltk-widgets-buttons-repeat.adb +++ b/src/fltk-widgets-buttons-repeat.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Buttons.Repeat is procedure Finalize (This : in out Repeat_Button) is begin - if This in Repeat_Button and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Repeat_Button'Class then free_fl_repeat_button (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-toggle.adb b/src/fltk-widgets-buttons-toggle.adb index a228130..e03d2ab 100644 --- a/src/fltk-widgets-buttons-toggle.adb +++ b/src/fltk-widgets-buttons-toggle.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Buttons.Toggle is procedure Finalize (This : in out Toggle_Button) is begin - if This in Toggle_Button and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Toggle_Button'Class then free_fl_toggle_button (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons.adb b/src/fltk-widgets-buttons.adb index 4eb2ffb..bdc4810 100644 --- a/src/fltk-widgets-buttons.adb +++ b/src/fltk-widgets-buttons.adb @@ -72,10 +72,11 @@ package body FLTK.Widgets.Buttons is procedure Finalize (This : in out Button) is begin - if This in Button and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Button'Class then free_fl_button (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk-widgets-groups-text_displays-text_editors.adb index 2424a7e..06564ef 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.adb +++ b/src/fltk-widgets-groups-text_displays-text_editors.adb @@ -85,11 +85,12 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure Finalize (This : in out Text_Editor) is begin - if This in Text_Editor and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Text_Editor'Class then This.Clear; free_fl_text_editor (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Text_Display (This)); end Finalize; diff --git a/src/fltk-widgets-groups-text_displays.adb b/src/fltk-widgets-groups-text_displays.adb index d8c58d0..9c571d3 100644 --- a/src/fltk-widgets-groups-text_displays.adb +++ b/src/fltk-widgets-groups-text_displays.adb @@ -143,11 +143,12 @@ package body FLTK.Widgets.Groups.Text_Displays is procedure Finalize (This : in out Text_Display) is begin - if This in Text_Display and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Text_Display'Class then This.Clear; free_fl_text_display (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Group (This)); end Finalize; diff --git a/src/fltk-widgets-groups-windows-double.adb b/src/fltk-widgets-groups-windows-double.adb index fc1c4dd..da48471 100644 --- a/src/fltk-widgets-groups-windows-double.adb +++ b/src/fltk-widgets-groups-windows-double.adb @@ -72,11 +72,12 @@ package body FLTK.Widgets.Groups.Windows.Double is procedure Finalize (This : in out Double_Window) is begin - if This in Double_Window and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Double_Window'Class then This.Clear; free_fl_double_window (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Window (This)); end Finalize; diff --git a/src/fltk-widgets-groups-windows-single-menu.adb b/src/fltk-widgets-groups-windows-single-menu.adb index 08e74e2..4f62763 100644 --- a/src/fltk-widgets-groups-windows-single-menu.adb +++ b/src/fltk-widgets-groups-windows-single-menu.adb @@ -90,11 +90,12 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is procedure Finalize (This : in out Menu_Window) is begin - if This in Menu_Window and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Menu_Window'Class then This.Clear; free_fl_menu_window (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Single_Window (This)); end Finalize; diff --git a/src/fltk-widgets-groups-windows-single.adb b/src/fltk-widgets-groups-windows-single.adb index ea7590c..bc89b10 100644 --- a/src/fltk-widgets-groups-windows-single.adb +++ b/src/fltk-widgets-groups-windows-single.adb @@ -72,11 +72,12 @@ package body FLTK.Widgets.Groups.Windows.Single is procedure Finalize (This : in out Single_Window) is begin - if This in Single_Window and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Single_Window'Class then This.Clear; free_fl_single_window (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Window (This)); end Finalize; diff --git a/src/fltk-widgets-groups-windows.adb b/src/fltk-widgets-groups-windows.adb index 54b29c4..866d502 100644 --- a/src/fltk-widgets-groups-windows.adb +++ b/src/fltk-widgets-groups-windows.adb @@ -94,11 +94,12 @@ package body FLTK.Widgets.Groups.Windows is procedure Finalize (This : in out Window) is begin - if This in Window and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Window'Class then This.Clear; free_fl_window (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Group (This)); end Finalize; diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb index 669e2a8..3b82d03 100644 --- a/src/fltk-widgets-groups.adb +++ b/src/fltk-widgets-groups.adb @@ -96,11 +96,12 @@ package body FLTK.Widgets.Groups is procedure Finalize (This : in out Group) is begin - if This in Group and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Group'Class then This.Clear; free_fl_group (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets-inputs-file.adb b/src/fltk-widgets-inputs-file.adb index 451232c..6ee0e84 100644 --- a/src/fltk-widgets-inputs-file.adb +++ b/src/fltk-widgets-inputs-file.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Inputs.File is procedure Finalize (This : in out File_Input) is begin - if This in File_Input and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in File_Input'Class then free_fl_file_input (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Input (This)); end Finalize; diff --git a/src/fltk-widgets-inputs-float.adb b/src/fltk-widgets-inputs-float.adb index 4769c8a..4e0b489 100644 --- a/src/fltk-widgets-inputs-float.adb +++ b/src/fltk-widgets-inputs-float.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Inputs.Float is procedure Finalize (This : in out Float_Input) is begin - if This in Float_Input and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Float_Input'Class then free_fl_float_input (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Input (This)); end Finalize; diff --git a/src/fltk-widgets-inputs-integer.adb b/src/fltk-widgets-inputs-integer.adb index 9234f60..92e95ec 100644 --- a/src/fltk-widgets-inputs-integer.adb +++ b/src/fltk-widgets-inputs-integer.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Inputs.Integer is procedure Finalize (This : in out Integer_Input) is begin - if This in Integer_Input and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Integer_Input'Class then free_fl_int_input (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Input (This)); end Finalize; diff --git a/src/fltk-widgets-inputs-multiline.adb b/src/fltk-widgets-inputs-multiline.adb index 5b76868..a24a8f0 100644 --- a/src/fltk-widgets-inputs-multiline.adb +++ b/src/fltk-widgets-inputs-multiline.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Inputs.Multiline is procedure Finalize (This : in out Multiline_Input) is begin - if This in Multiline_Input and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Multiline_Input'Class then free_fl_multiline_input (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Input (This)); end Finalize; diff --git a/src/fltk-widgets-inputs-outputs.adb b/src/fltk-widgets-inputs-outputs.adb index 8aa7021..6e6ff95 100644 --- a/src/fltk-widgets-inputs-outputs.adb +++ b/src/fltk-widgets-inputs-outputs.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Inputs.Outputs is procedure Finalize (This : in out Output) is begin - if This in Output and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Output'Class then free_fl_output (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Input (This)); end Finalize; diff --git a/src/fltk-widgets-inputs-secret.adb b/src/fltk-widgets-inputs-secret.adb index 46d0b0b..64f0c7f 100644 --- a/src/fltk-widgets-inputs-secret.adb +++ b/src/fltk-widgets-inputs-secret.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Inputs.Secret is procedure Finalize (This : in out Secret_Input) is begin - if This in Secret_Input and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Secret_Input'Class then free_fl_secret_input (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Input (This)); end Finalize; diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb index 322c51e..572d11c 100644 --- a/src/fltk-widgets-inputs.adb +++ b/src/fltk-widgets-inputs.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Inputs is procedure Finalize (This : in out Input) is begin - if This in Input and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Input'Class then free_fl_input (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets-menus-menu_bars.adb b/src/fltk-widgets-menus-menu_bars.adb index 1ca0179..918ebe1 100644 --- a/src/fltk-widgets-menus-menu_bars.adb +++ b/src/fltk-widgets-menus-menu_bars.adb @@ -59,10 +59,11 @@ package body FLTK.Widgets.Menus.Menu_Bars is procedure Finalize (This : in out Menu_Bar) is begin - if This in Menu_Bar and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Menu_Bar'Class then free_fl_menu_bar (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Menu (This)); end Finalize; diff --git a/src/fltk-widgets-menus-menu_buttons.adb b/src/fltk-widgets-menus-menu_buttons.adb index 4fedc08..b174db8 100644 --- a/src/fltk-widgets-menus-menu_buttons.adb +++ b/src/fltk-widgets-menus-menu_buttons.adb @@ -64,10 +64,11 @@ package body FLTK.Widgets.Menus.Menu_Buttons is procedure Finalize (This : in out Menu_Button) is begin - if This in Menu_Button and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Menu_Button'Class then free_fl_menu_button (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Menu (This)); end Finalize; diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb index 7e201b5..1605ccd 100644 --- a/src/fltk-widgets-menus.adb +++ b/src/fltk-widgets-menus.adb @@ -91,10 +91,11 @@ package body FLTK.Widgets.Menus is procedure Finalize (This : in out Menu) is begin - if This in Menu and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Menu'Class then free_fl_menu (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb index d46b1c4..458a88c 100644 --- a/src/fltk-widgets.adb +++ b/src/fltk-widgets.adb @@ -146,10 +146,11 @@ package body FLTK.Widgets is procedure Finalize (This : in out Widget) is begin - if This in Widget and then - This.Void_Ptr /= System.Null_Address + if This.Void_Ptr /= System.Null_Address and then + This in Widget'Class then free_fl_widget (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; end if; end Finalize; |