Ensured Widgets will remove themselves from a Group upon dealloc and Groups won't inadvertantly dealloc Widgets upon Clear

1 files changed, 36 insertions, 22 deletions

diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb
index 870eade..beae56d 100644
--- a/src/fltk-widgets.adb
+++ b/src/fltk-widgets.adb
@@ -6,6 +6,7 @@
 
 with
 
+    Ada.Assertions,
     Interfaces.C.Strings,
     System.Address_To_Access_Conversions,
     FLTK.Widgets.Groups.Windows,
@@ -21,6 +22,9 @@ use type
 package body FLTK.Widgets is
 
 
+    package Chk renames Ada.Assertions;
+
+
     function "+"
            (Left, Right : in Callback_Flag)
         return Callback_Flag is
@@ -29,8 +33,6 @@ package body FLTK.Widgets is
     end "+";
 
 
-
-
     package Group_Convert is new
         System.Address_To_Access_Conversions (FLTK.Widgets.Groups.Group'Class);
 
@@ -516,9 +518,13 @@ package body FLTK.Widgets is
     -------------------
 
     procedure Extra_Final
-           (This : in out Widget) is
+           (This : in out Widget)
+    is
+        Maybe_Parent : access FLTK.Widgets.Groups.Group'Class := This.Parent;
     begin
-        null;
+        if Maybe_Parent /= null then
+            Maybe_Parent.Remove (This);
+        end if;
     end Extra_Final;
 
 
@@ -772,15 +778,17 @@ package body FLTK.Widgets is
            (This : in Widget)
         return access FLTK.Widgets.Groups.Group'Class
     is
-        Parent_Ptr : Storage.Integer_Address;
+        Parent_Ptr : Storage.Integer_Address := fl_widget_get_parent (This.Void_Ptr);
         Actual_Parent : access FLTK.Widgets.Groups.Group'Class;
     begin
-        Parent_Ptr := fl_widget_get_parent (This.Void_Ptr);
         if Parent_Ptr /= Null_Pointer then
-            Actual_Parent := Group_Convert.To_Pointer
-                (Storage.To_Address (fl_widget_get_user_data (Parent_Ptr)));
+            Parent_Ptr := fl_widget_get_user_data (Parent_Ptr);
+            pragma Assert (Parent_Ptr /= Null_Pointer);
+            Actual_Parent := Group_Convert.To_Pointer (Storage.To_Address (Parent_Ptr));
         end if;
         return Actual_Parent;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Parent;
 
 
@@ -806,15 +814,17 @@ package body FLTK.Widgets is
            (This : in Widget)
         return access FLTK.Widgets.Groups.Windows.Window'Class
     is
-        Window_Ptr : Storage.Integer_Address;
+        Window_Ptr : Storage.Integer_Address := fl_widget_window (This.Void_Ptr);
         Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class;
     begin
-        Window_Ptr := fl_widget_window (This.Void_Ptr);
         if Window_Ptr /= Null_Pointer then
-            Actual_Window := Window_Convert.To_Pointer
-                (Storage.To_Address (fl_widget_get_user_data (Window_Ptr)));
+            Window_Ptr := fl_widget_get_user_data (Window_Ptr);
+            pragma Assert (Window_Ptr /= Null_Pointer);
+            Actual_Window := Window_Convert.To_Pointer (Storage.To_Address (Window_Ptr));
         end if;
         return Actual_Window;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Nearest_Window;
 
 
@@ -822,15 +832,17 @@ package body FLTK.Widgets is
            (This : in Widget)
         return access FLTK.Widgets.Groups.Windows.Window'Class
     is
-        Window_Ptr : Storage.Integer_Address;
+        Window_Ptr : Storage.Integer_Address := fl_widget_top_window (This.Void_Ptr);
         Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class;
     begin
-        Window_Ptr := fl_widget_top_window (This.Void_Ptr);
         if Window_Ptr /= Null_Pointer then
-            Actual_Window := Window_Convert.To_Pointer
-                (Storage.To_Address (fl_widget_get_user_data (Window_Ptr)));
+            Window_Ptr := fl_widget_get_user_data (Window_Ptr);
+            pragma Assert (Window_Ptr /= Null_Pointer);
+            Actual_Window := Window_Convert.To_Pointer (Storage.To_Address (Window_Ptr));
         end if;
         return Actual_Window;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Top_Window;
 
 
@@ -839,18 +851,20 @@ package body FLTK.Widgets is
             Offset_X, Offset_Y : out Integer)
         return access FLTK.Widgets.Groups.Windows.Window'Class
     is
-        Window_Ptr : Storage.Integer_Address;
-        Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class;
-    begin
-        Window_Ptr := fl_widget_top_window_offset
+        Window_Ptr : Storage.Integer_Address := fl_widget_top_window_offset
            (This.Void_Ptr,
             Interfaces.C.int (Offset_X),
             Interfaces.C.int (Offset_Y));
+        Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class;
+    begin
         if Window_Ptr /= Null_Pointer then
-            Actual_Window := Window_Convert.To_Pointer
-                (Storage.To_Address (fl_widget_get_user_data (Window_Ptr)));
+            Window_Ptr := fl_widget_get_user_data (Window_Ptr);
+            pragma Assert (Window_Ptr /= Null_Pointer);
+            Actual_Window := Window_Convert.To_Pointer (Storage.To_Address (Window_Ptr));
         end if;
         return Actual_Window;
+    exception
+    when Chk.Assertion_Error => raise Internal_FLTK_Error;
     end Top_Window_Offset;