From d45103f2445ed59b7ba78faeae8061327c4ab976 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Tue, 15 May 2018 16:30:58 +1000 Subject: Fixed errors with Event Dispatch and null string pointers --- doc/fl.html | 12 ++--- src/fltk-dialogs.adb | 24 ++++++++-- src/fltk-environment.adb | 34 ++++++++++---- src/fltk-event.adb | 42 +++++++++++------ src/fltk-event.ads | 24 +++++----- src/fltk-images-shared.adb | 11 ++++- src/fltk-menu_items.adb | 13 ++++-- src/fltk-static.adb | 15 ++++-- src/fltk-text_buffers.adb | 78 ++++++++++++++++++++++++------- src/fltk-widgets-groups-input_choices.adb | 13 ++++-- src/fltk-widgets-groups-windows.adb | 25 +++++++--- src/fltk-widgets-inputs-file.adb | 13 ++++-- src/fltk-widgets-inputs-float.adb | 12 +++-- src/fltk-widgets-inputs-integer.adb | 12 +++-- src/fltk-widgets-inputs.adb | 13 ++++-- src/fltk-widgets-menus.adb | 15 ++++-- src/fltk-widgets.adb | 23 +++++++-- 17 files changed, 277 insertions(+), 102 deletions(-) diff --git a/doc/fl.html b/doc/fl.html index b5c9905..f1da128 100644 --- a/doc/fl.html +++ b/doc/fl.html @@ -136,7 +136,7 @@ Fl_Event_Dispatch - Event_Dispatch + TBA @@ -803,20 +803,14 @@ function Key_Ctrl 
 static void event_dispatch(Fl_Event_Dispatch d);
-
-procedure Set_Dispatch
-       (Func : in Event_Dispatch);
-
+TBA 
 static Fl_Event_Dispatch event_dispatch();
-
-function Get_Dispatch
-    return Event_Dispatch;
-
+TBA diff --git a/src/fltk-dialogs.adb b/src/fltk-dialogs.adb index 7f0629c..349fd1f 100644 --- a/src/fltk-dialogs.adb +++ b/src/fltk-dialogs.adb @@ -168,7 +168,11 @@ package body FLTK.Dialogs is Interfaces.C.To_C (Default)); begin -- string does not need dealloc - return Interfaces.C.Strings.Value (Result); + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; end Text_Input; @@ -189,7 +193,11 @@ package body FLTK.Dialogs is Interfaces.C.To_C (Default)); begin -- string does not need dealloc - return Interfaces.C.Strings.Value (Result); + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; end Password; @@ -248,7 +256,11 @@ package body FLTK.Dialogs is Boolean'Pos (Relative)); begin -- I'm... fairly sure the string does not need dealloc? - return Interfaces.C.Strings.Value (Result); + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; end Dir_Chooser; @@ -264,7 +276,11 @@ package body FLTK.Dialogs is Boolean'Pos (Relative)); begin -- I'm... fairly sure the string does not need dealloc? - return Interfaces.C.Strings.Value (Result); + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; end File_Chooser; diff --git a/src/fltk-environment.adb b/src/fltk-environment.adb index 1c4cf28..ae832c0 100644 --- a/src/fltk-environment.adb +++ b/src/fltk-environment.adb @@ -8,6 +8,7 @@ with use type Interfaces.C.int, + Interfaces.C.Strings.chars_ptr, System.Address; @@ -228,10 +229,13 @@ package body FLTK.Environment is is Key : Interfaces.C.Strings.chars_ptr := fl_preferences_entry (This.Void_Ptr, Interfaces.C.int (Index)); - Str : String := Interfaces.C.Strings.Value (Key); begin -- no need for dealloc? - return Str; + if Key = Interfaces.C.Strings.Null_Ptr then + raise Constraint_Error; + else + return Interfaces.C.Strings.Value (Key); + end if; end Get_Key; @@ -320,13 +324,20 @@ package body FLTK.Environment is Interfaces.C.To_C (Key), Value, Interfaces.C.To_C ("default")); - Str : String := Interfaces.C.Strings.Value (Value); begin - Interfaces.C.Strings.Free (Value); if Check = 0 then raise Preference_Error; end if; - return Str; + if Value = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + Str : String := Interfaces.C.Strings.Value (Value); + begin + Interfaces.C.Strings.Free (Value); + return Str; + end; + end if; end Get; @@ -397,10 +408,17 @@ package body FLTK.Environment is Interfaces.C.To_C (Key), Value, Interfaces.C.To_C (Default)); - Str : String := Interfaces.C.Strings.Value (Value); begin - Interfaces.C.Strings.Free (Value); - return Str; + if Value = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + Str : String := Interfaces.C.Strings.Value (Value); + begin + Interfaces.C.Strings.Free (Value); + return Str; + end; + end if; end Get; diff --git a/src/fltk-event.adb b/src/fltk-event.adb index 34a86e1..eb0bc01 100644 --- a/src/fltk-event.adb +++ b/src/fltk-event.adb @@ -2,11 +2,14 @@ with - Interfaces.C.Strings; + Interfaces.C.Strings, + System; use type - Interfaces.C.int; + Interfaces.C.int, + Interfaces.C.Strings.chars_ptr, + System.Address; package body FLTK.Event is @@ -264,13 +267,15 @@ package body FLTK.Event is return Interfaces.C.int is Ret_Val : Event_Outcome; - Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class := - Window_Convert.To_Pointer (fl_widget_get_user_data (Ptr)); + Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class; begin + if Ptr /= System.Null_Address then + Actual_Window := Window_Convert.To_Pointer (fl_widget_get_user_data (Ptr)); + end if; if Current_Dispatch = null then - Ret_Val := Default_Dispatch (Event_Kind'Val (Num), Actual_Window.all); + Ret_Val := Default_Dispatch (Event_Kind'Val (Num), Actual_Window); else - Ret_Val := Current_Dispatch (Event_Kind'Val (Num), Actual_Window.all); + Ret_Val := Current_Dispatch (Event_Kind'Val (Num), Actual_Window); end if; return Event_Outcome'Pos (Ret_Val); end Dispatch_Hook; @@ -317,12 +322,17 @@ package body FLTK.Event is function Default_Dispatch (Event : in Event_Kind; - Win : in out FLTK.Widgets.Groups.Windows.Window'Class) + Win : access FLTK.Widgets.Groups.Windows.Window'Class) return Event_Outcome is begin - return Event_Outcome'Val (fl_event_handle - (Event_Kind'Pos (Event), - Wrapper (Win).Void_Ptr)); + if Win = null then + return Event_Outcome'Val (fl_event_handle + (Event_Kind'Pos (Event), System.Null_Address)); + else + return Event_Outcome'Val (fl_event_handle + (Event_Kind'Pos (Event), + Wrapper (Win.all).Void_Ptr)); + end if; end Default_Dispatch; @@ -406,9 +416,15 @@ package body FLTK.Event is function Text - return String is + return String + is + Str : Interfaces.C.Strings.chars_ptr := fl_event_text; begin - return Interfaces.C.Strings.Value (fl_event_text, Interfaces.C.size_t (fl_event_length)); + if Str = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Str, Interfaces.C.size_t (fl_event_length)); + end if; end Text; @@ -620,7 +636,7 @@ begin fl_event_add_handler (Event_Handler_Hook'Address); - fl_event_set_event_dispatch (Dispatch_Hook'Address); + --fl_event_set_event_dispatch (Dispatch_Hook'Address); end FLTK.Event; diff --git a/src/fltk-event.ads b/src/fltk-event.ads index 17f5a1c..df53eb0 100644 --- a/src/fltk-event.ads +++ b/src/fltk-event.ads @@ -17,10 +17,10 @@ package FLTK.Event is (Event : in Event_Kind) return Event_Outcome; - type Event_Dispatch is access function - (Event : in Event_Kind; - Win : in out FLTK.Widgets.Groups.Windows.Window'Class) - return Event_Outcome; + -- type Event_Dispatch is access function + -- (Event : in Event_Kind; + -- Win : access FLTK.Widgets.Groups.Windows.Window'Class) + -- return Event_Outcome; @@ -31,16 +31,16 @@ package FLTK.Event is procedure Remove_Handler (Func : in Event_Handler); - function Get_Dispatch - return Event_Dispatch; + -- function Get_Dispatch + -- return Event_Dispatch; - procedure Set_Dispatch - (Func : in Event_Dispatch); + -- procedure Set_Dispatch + -- (Func : in Event_Dispatch); - function Default_Dispatch - (Event : in Event_Kind; - Win : in out FLTK.Widgets.Groups.Windows.Window'Class) - return Event_Outcome; + -- function Default_Dispatch + -- (Event : in Event_Kind; + -- Win : access FLTK.Widgets.Groups.Windows.Window'Class) + -- return Event_Outcome; diff --git a/src/fltk-images-shared.adb b/src/fltk-images-shared.adb index 0e36e6e..2d20e3c 100644 --- a/src/fltk-images-shared.adb +++ b/src/fltk-images-shared.adb @@ -7,6 +7,7 @@ with use type + Interfaces.C.Strings.chars_ptr, System.Address; @@ -223,9 +224,15 @@ package body FLTK.Images.Shared is function Name (This : in Shared_Image) - return String is + return String + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_shared_image_name (This.Void_Ptr); begin - return Interfaces.C.Strings.Value (fl_shared_image_name (This.Void_Ptr)); + if Ptr = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Ptr); + end if; end Name; diff --git a/src/fltk-menu_items.adb b/src/fltk-menu_items.adb index 4c0e78c..69a8014 100644 --- a/src/fltk-menu_items.adb +++ b/src/fltk-menu_items.adb @@ -9,7 +9,8 @@ with use type System.Address, - Interfaces.C.int; + Interfaces.C.int, + Interfaces.C.Strings.chars_ptr; package body FLTK.Menu_Items is @@ -340,9 +341,15 @@ package body FLTK.Menu_Items is function Get_Label (Item : in Menu_Item) - return String is + return String + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_menu_item_get_label (Item.Void_Ptr); begin - return Interfaces.C.Strings.Value (fl_menu_item_get_label (Item.Void_Ptr)); + if Ptr = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Ptr); + end if; end Get_Label; procedure Set_Label diff --git a/src/fltk-static.adb b/src/fltk-static.adb index 41771f9..3ec3938 100644 --- a/src/fltk-static.adb +++ b/src/fltk-static.adb @@ -8,7 +8,8 @@ with use type - Interfaces.C.int; + Interfaces.C.int, + Interfaces.C.Strings.chars_ptr; package body FLTK.Static is @@ -721,6 +722,7 @@ package body FLTK.Static is (Kind : in Font_Kind) return String is begin + -- should never get a null string in return since it's from an enum return Interfaces.C.Strings.Value (fl_static_get_font (Font_Kind'Pos (Kind))); end Font_Image; @@ -729,6 +731,7 @@ package body FLTK.Static is (Kind : in Font_Kind) return String is begin + -- should never get a null string in return since it's from an enum return Interfaces.C.Strings.Value (fl_static_get_font_name (Font_Kind'Pos (Kind))); end Font_Family_Image; @@ -947,9 +950,15 @@ package body FLTK.Static is function Get_Scheme - return String is + return String + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_static_get_scheme; begin - return Interfaces.C.Strings.Value (fl_static_get_scheme); + if Ptr = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Ptr); + end if; end Get_Scheme; diff --git a/src/fltk-text_buffers.adb b/src/fltk-text_buffers.adb index 92e4922..5fec63b 100644 --- a/src/fltk-text_buffers.adb +++ b/src/fltk-text_buffers.adb @@ -767,10 +767,17 @@ package body FLTK.Text_Buffers is is Raw : Interfaces.C.Strings.chars_ptr := fl_text_buffer_get_text (This.Void_Ptr); - Ada_String : String := Interfaces.C.Strings.Value (Raw); begin - Interfaces.C.Strings.Free (Raw); - return Ada_String; + if Raw = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + Ada_String : String := Interfaces.C.Strings.Value (Raw); + begin + Interfaces.C.Strings.Free (Raw); + return Ada_String; + end; + end if; end Get_Entire_Text; @@ -812,10 +819,17 @@ package body FLTK.Text_Buffers is (This.Void_Ptr, Interfaces.C.int (Start), Interfaces.C.int (Finish)); - The_Text : String := Interfaces.C.Strings.Value (C_Str); begin - Interfaces.C.Strings.Free (C_Str); - return The_Text; + if C_Str = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + The_Text : String := Interfaces.C.Strings.Value (C_Str); + begin + Interfaces.C.Strings.Free (C_Str); + return The_Text; + end; + end if; end Text_At; @@ -961,10 +975,17 @@ package body FLTK.Text_Buffers is is Raw : Interfaces.C.Strings.chars_ptr := fl_text_buffer_selection_text (This.Void_Ptr); - Ada_String : String := Interfaces.C.Strings.Value (Raw); begin - Interfaces.C.Strings.Free (Raw); - return Ada_String; + if Raw = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + Ada_String : String := Interfaces.C.Strings.Value (Raw); + begin + Interfaces.C.Strings.Free (Raw); + return Ada_String; + end; + end if; end Selection_Text; @@ -974,10 +995,17 @@ package body FLTK.Text_Buffers is is Raw : Interfaces.C.Strings.chars_ptr := fl_text_buffer_secondary_selection_text (This.Void_Ptr); - Ada_String : String := Interfaces.C.Strings.Value (Raw); begin - Interfaces.C.Strings.Free (Raw); - return Ada_String; + if Raw = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + Ada_String : String := Interfaces.C.Strings.Value (Raw); + begin + Interfaces.C.Strings.Free (Raw); + return Ada_String; + end; + end if; end Secondary_Selection_Text; @@ -1055,10 +1083,17 @@ package body FLTK.Text_Buffers is is Raw : Interfaces.C.Strings.chars_ptr := fl_text_buffer_highlight_text (This.Void_Ptr); - Ada_String : String := Interfaces.C.Strings.Value (Raw); begin - Interfaces.C.Strings.Free (Raw); - return Ada_String; + if Raw = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + Ada_String : String := Interfaces.C.Strings.Value (Raw); + begin + Interfaces.C.Strings.Free (Raw); + return Ada_String; + end; + end if; end Get_Highlighted_Text; @@ -1181,10 +1216,17 @@ package body FLTK.Text_Buffers is Raw : Interfaces.C.Strings.chars_ptr := fl_text_buffer_line_text (This.Void_Ptr, Interfaces.C.int (Place)); - Ada_String : String := Interfaces.C.Strings.Value (Raw); begin - Interfaces.C.Strings.Free (Raw); - return Ada_String; + if Raw = Interfaces.C.Strings.Null_Ptr then + return ""; + else + declare + Ada_String : String := Interfaces.C.Strings.Value (Raw); + begin + Interfaces.C.Strings.Free (Raw); + return Ada_String; + end; + end if; end Line_Text; diff --git a/src/fltk-widgets-groups-input_choices.adb b/src/fltk-widgets-groups-input_choices.adb index 366eade..223e33d 100644 --- a/src/fltk-widgets-groups-input_choices.adb +++ b/src/fltk-widgets-groups-input_choices.adb @@ -9,6 +9,7 @@ with use type Interfaces.C.int, + Interfaces.C.Strings.chars_ptr, System.Address; @@ -348,10 +349,16 @@ package body FLTK.Widgets.Groups.Input_Choices is function Get_Input (This : in Input_Choice) - return String is + return String + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_input_choice_get_value (This.Void_Ptr); begin - -- pointer to internal buffer so no free necessary - return Interfaces.C.Strings.Value (fl_input_choice_get_value (This.Void_Ptr)); + if Ptr = Interfaces.C.Strings.Null_Ptr then + return ""; + else + -- pointer to internal buffer so no free necessary + return Interfaces.C.Strings.Value (Ptr); + end if; end Get_Input; diff --git a/src/fltk-widgets-groups-windows.adb b/src/fltk-widgets-groups-windows.adb index a4da35b..590c915 100644 --- a/src/fltk-widgets-groups-windows.adb +++ b/src/fltk-widgets-groups-windows.adb @@ -10,6 +10,7 @@ use type Interfaces.C.int, Interfaces.C.unsigned, + Interfaces.C.Strings.chars_ptr, System.Address; @@ -490,10 +491,16 @@ package body FLTK.Widgets.Groups.Windows is function Get_Icon_Label (This : in Window) - return String is + return String + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_window_get_iconlabel (This.Void_Ptr); begin - -- pointer to internal buffer only, so no Free required - return Interfaces.C.Strings.Value (fl_window_get_iconlabel (This.Void_Ptr)); + if Ptr = Interfaces.C.Strings.Null_Ptr then + return ""; + else + -- pointer to internal buffer only, so no Free required + return Interfaces.C.Strings.Value (Ptr); + end if; end Get_Icon_Label; @@ -600,10 +607,16 @@ package body FLTK.Widgets.Groups.Windows is function Get_Label (This : in Window) - return String is + return String + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_window_get_label (This.Void_Ptr); begin - -- pointer to internal buffer only, so no Free required - return Interfaces.C.Strings.Value (fl_window_get_label (This.Void_Ptr)); + if Ptr = Interfaces.C.Strings.Null_Ptr then + return ""; + else + -- pointer to internal buffer only, so no Free required + return Interfaces.C.Strings.Value (Ptr); + end if; end Get_Label; diff --git a/src/fltk-widgets-inputs-file.adb b/src/fltk-widgets-inputs-file.adb index 222b847..92836c8 100644 --- a/src/fltk-widgets-inputs-file.adb +++ b/src/fltk-widgets-inputs-file.adb @@ -7,6 +7,7 @@ with use type + Interfaces.C.Strings.chars_ptr, System.Address; @@ -177,10 +178,16 @@ package body FLTK.Widgets.Inputs.File is function Get_Value (This : in Input) - return String is + return String + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_file_input_get_value (This.Void_Ptr); begin - -- pointer to internal buffer only, so no Free required - return Interfaces.C.Strings.Value (fl_file_input_get_value (This.Void_Ptr)); + if Ptr = Interfaces.C.Strings.Null_Ptr then + return ""; + else + -- pointer to internal buffer only, so no Free required + return Interfaces.C.Strings.Value (Ptr); + end if; end Get_Value; diff --git a/src/fltk-widgets-inputs-float.adb b/src/fltk-widgets-inputs-float.adb index 3b1b5b3..1ddb2f2 100644 --- a/src/fltk-widgets-inputs-float.adb +++ b/src/fltk-widgets-inputs-float.adb @@ -7,6 +7,7 @@ with use type + Interfaces.C.Strings.chars_ptr, System.Address; @@ -100,10 +101,15 @@ package body FLTK.Widgets.Inputs.Float is function Get_Value (This : in Float_Input) - return Standard.Float is + return Standard.Float + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); begin - return Standard.Float'Value - (Interfaces.C.Strings.Value (fl_input_get_value (This.Void_Ptr))); + if Ptr = Interfaces.C.Strings.Null_Ptr then + return 0.0; + else + return Standard.Float'Value (Interfaces.C.Strings.Value (Ptr)); + end if; end Get_Value; diff --git a/src/fltk-widgets-inputs-integer.adb b/src/fltk-widgets-inputs-integer.adb index 2f41e73..1e04d5a 100644 --- a/src/fltk-widgets-inputs-integer.adb +++ b/src/fltk-widgets-inputs-integer.adb @@ -7,6 +7,7 @@ with use type + Interfaces.C.Strings.chars_ptr, System.Address; @@ -100,10 +101,15 @@ package body FLTK.Widgets.Inputs.Integer is function Get_Value (This : in Integer_Input) - return Standard.Integer is + return Standard.Integer + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); begin - return Standard.Integer'Value - (Interfaces.C.Strings.Value (fl_input_get_value (This.Void_Ptr))); + if Ptr = Interfaces.C.Strings.Null_Ptr then + return 0; + else + return Standard.Integer'Value (Interfaces.C.Strings.Value (Ptr)); + end if; end Get_Value; diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb index b0796b6..994937a 100644 --- a/src/fltk-widgets-inputs.adb +++ b/src/fltk-widgets-inputs.adb @@ -8,6 +8,7 @@ with use type Interfaces.C.int, + Interfaces.C.Strings.chars_ptr, System.Address; @@ -568,10 +569,16 @@ package body FLTK.Widgets.Inputs is function Get_Value (This : in Input) - return String is + return String + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_input_get_value (This.Void_Ptr); begin - -- pointer to internal buffer only, so no Free required - return Interfaces.C.Strings.Value (fl_input_get_value (This.Void_Ptr)); + if Ptr = Interfaces.C.Strings.Null_Ptr then + return ""; + else + -- pointer to internal buffer only, so no Free required + return Interfaces.C.Strings.Value (Ptr); + end if; end Get_Value; diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb index d6148f2..03333d2 100644 --- a/src/fltk-widgets-menus.adb +++ b/src/fltk-widgets-menus.adb @@ -10,7 +10,8 @@ use type System.Address, Interfaces.C.int, - Interfaces.C.unsigned_long; + Interfaces.C.unsigned_long, + Interfaces.C.Strings.chars_ptr; package body FLTK.Widgets.Menus is @@ -561,10 +562,16 @@ package body FLTK.Widgets.Menus is function Chosen_Label (This : in Menu) - return String is + return String + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_menu_text (This.Void_Ptr); begin - -- no dealloc required? - return Interfaces.C.Strings.Value (fl_menu_text (This.Void_Ptr)); + if Ptr = Interfaces.C.Strings.Null_Ptr then + return ""; + else + -- no dealloc required? + return Interfaces.C.Strings.Value (Ptr); + end if; end Chosen_Label; diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb index 40890c4..73d3e17 100644 --- a/src/fltk-widgets.adb +++ b/src/fltk-widgets.adb @@ -11,6 +11,7 @@ use type Interfaces.C.int, Interfaces.C.unsigned, + Interfaces.C.Strings.chars_ptr, System.Address; @@ -844,10 +845,16 @@ package body FLTK.Widgets is function Get_Tooltip (This : in Widget) - return String is + return String + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_widget_tooltip (This.Void_Ptr); begin - -- no need for dealloc - return Interfaces.C.Strings.Value (fl_widget_tooltip (This.Void_Ptr)); + if Ptr = Interfaces.C.Strings.Null_Ptr then + return ""; + else + -- no need for dealloc + return Interfaces.C.Strings.Value (Ptr); + end if; end Get_Tooltip; @@ -863,9 +870,15 @@ package body FLTK.Widgets is function Get_Label (This : in Widget) - return String is + return String + is + Ptr : Interfaces.C.Strings.chars_ptr := fl_widget_get_label (This.Void_Ptr); begin - return Interfaces.C.Strings.Value (fl_widget_get_label (This.Void_Ptr)); + if Ptr = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Ptr); + end if; end Get_Label; -- cgit