[gvd-devel] GVD 1.2.5 bug report; display erased attempting to examine array
formal parameter.
Nash, D. LTC EECS
dd9875@exmail.usma.army.mil
Mon, 22 Apr 2002 17:09:55 -0400
This message is in MIME format. Since your mail reader does not understand
this format, some or all of this message may not be legible.
------_=_NextPart_000_01C1EA42.0D7C8510
Content-Type: text/plain;
charset="iso-8859-1"
> Oops, hit the send button by mistake on my previous message before
> finishing ...
>
> Dear friends,
>
> Enclosed please find a main subprogram proj4.adb, with supporting packages
> (still being debugged, by the way :) ). I have noticed what may be a bug
> in GVD 1.2.5 while debugging this program. The development environment is
> as follows:
>
> Solaris 7
> GNAT version 3.13p
> GtkAda version 1.3.12
>
> Here are the steps that will reproduce the bug for me:
>
> 1) Enable a breakpoint on line # 123 of huffman.adb.
>
> 2) Run to the breakpoint.
>
> 3) Pass the mouse cursor over any mention of the parameter Freq_Array
> within the surrounding subprogram Build_Huffman_Tree. Whereas one would
> expect the value of the array to be displayed as a tooltip, the display
> vanishes. I notice the same behavior attempting to right-click
> Freq_Array. Freq_Array is declared in huffman.ads as
>
> type Frequency_Array is array(Character) of Natural;
>
> Very cordially,
>
>
> David A. Nash
> LTC, FA
> Computer Support Group
> Dept. of Electrical Engineering and Computer Science
> Thayer Hall, bldg. 601, room 1115
> (845) 938-5575 (voice) (845) 938-5956 (fax)
>
> <<huffman_tree.adb>> <<huffman_tree.ads>> <<linked_list3.adb>>
> <<linked_list3.ads>> <<proj4.adb>> <<thefile.txt>>
------_=_NextPart_000_01C1EA42.0D7C8510
Content-Type: application/octet-stream;
name="huffman_tree.adb"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="huffman_tree.adb"
with Ada.Unchecked_Deallocation, Ada.Text_IO;
use Ada.Text_Io;
package body Huffman_Tree is
procedure Free is
new Ada.Unchecked_Deallocation( String, String_Ptr );
---------------------------
-- Purge_Considered_Tree --
---------------------------
-- Walk through the list, deleting any nodes for which the
-- "considered" field is marked as True.
procedure Purge_Considered_Tree
( Tree_List : in out Tree_List_Pack.List )
is
Pointer : Tree_List_Pack.Position;
Tree : Huffman_Tree;
begin
if not Tree_List_Pack.Is_Empty( Tree_List ) then
Pointer :=3D Tree_List_Pack.First( Tree_List );
loop
-- Retrieve the record indicated by the pointer:
Tree :=3D Tree_List_Pack.Retrieve( Pointer, Tree_List );
if Tree.Considered then
Tree_List_Pack.Delete( Tree_List, Pointer );
exit;
else
Tree_List_Pack.Advance( Pointer, Tree_List );
end if;
end loop;
end if;
end Purge_Considered_Tree;
--------------------------------------
-- Accumulate_Character_Frequencies --
--------------------------------------
procedure Accumulate_Character_Frequencies
(Text : in String;
Freq_Array : in out Frequency_Array)
is
begin
for I in Text'Range loop
Freq_Array(Text(I)) :=3D Freq_Array(Text(I)) + 1;
end loop;
end Accumulate_Character_Frequencies;
------------------------
-- Build_Huffman_Tree --
------------------------
function Build_Huffman_Tree
(Freq_Array : Frequency_Array)
return Huffman_Tree
is
Result : Huffman_Tree :=3D null;
List_Of_Trees : Tree_List_Pack.List;
Huff_Tree : Huffman_Tree;
Small_Tree1, Small_Tree2 : Huffman_Tree;
Union_Tree : Huffman_Tree;
begin
-- Initialize the list of trees:
Tree_List_Pack.Make_Empty( List_Of_Trees );
-- Initialize the list by inserting single-node trees for each
-- of the characters with non-zero frequencies:
for I in Freq_Array'Range loop
if Freq_Array(I) > 0 then
Huff_Tree :=3D new Huffman_Record;
Huff_Tree.Char :=3D I;
Huff_Tree.Weight :=3D Freq_Array(I);
Huff_Tree.Left :=3D null;
Huff_Tree.Right :=3D null;
Huff_Tree.Considered :=3D False;
Tree_List_Pack.Insert_As_First_Element
( Huff_Tree, List_Of_Trees );
end if;
end loop;
-- Merge the trees of smallest weight until we're left with one
-- tree:
while Tree_List_Pack.Count( List_Of_Trees ) > 1 loop
Put_Line( Natural'Image
( Tree_List_Pack.Count( List_Of_Trees ) ) & " =
subtrees" );
Small_Tree1 :=3D Find_Tree_Of_Smallest_Weight( List_Of_Trees =
);
Purge_Considered_Tree( List_Of_Trees );
Small_Tree2 :=3D Find_Tree_Of_Smallest_Weight( List_Of_Trees =
);
Purge_Considered_Tree( List_Of_Trees );
Union_Tree :=3D new Huffman_Record;
Union_Tree.Left :=3D Small_Tree1;
Union_Tree.Right :=3D Small_Tree2;
Union_Tree.Weight :=3D Small_Tree1.Weight + =
Small_Tree2.Weight;
-- ... and add their union:
Tree_List_Pack.Insert_As_First_Element
( Union_Tree, List_Of_Trees );
Put_Line( Natural'Image
( Tree_List_Pack.Count( List_Of_Trees ) ) & " =
subtrees" );
end loop;
-- Return that single tree as the result:
Result :=3D
Tree_List_Pack.Retrieve( Tree_List_Pack.First( List_Of_Trees ) =
);
return Result;
end Build_Huffman_Tree;
----------------
-- DecodeFile --
----------------
procedure DecodeFile (Input_File : String) is
begin
null;
end DecodeFile;
-----------------
-- Encode_File --
-----------------
procedure Encode_File (Input_File : String) is
Current_Max_Line_Length : Positive :=3D 500;
Buffer : String_Ptr;
Encode_Freq_Array : Frequency_Array :=3D ( others =
=3D> 0 );
Handle : Ada.Text_IO.File_Type;
NumCharsRead : Natural :=3D =
Natural'First;
TheTree : Huffman_Tree :=3D null;
begin
-- Allocate a string buffer:
Buffer :=3D new String( 1 .. Current_Max_Line_Length );
Buffer.all :=3D ( others =3D> '@' );
-- Open the file:
Ada.Text_IO.Open( Handle, Ada.Text_IO.In_File, Input_File );
-- Count the number of characters in the file. If necessary,
-- increase the size of the buffer to accomodate longer lines:
while not Ada.Text_IO.End_Of_File( Handle ) loop
begin
Ada.Text_IO.Get_Line( Handle, Buffer.all, NumCharsRead );
Accumulate_Character_Frequencies( Buffer.all, =
Encode_Freq_Array );
exception
when CONSTRAINT_ERROR =3D>
-- Increase the current maximum size:
Current_Max_Line_Length :=3D Current_Max_Line_Length + =
500;
-- Release the previous buffer:
Free(Buffer);
-- Allocate the new larger buffer:
Buffer :=3D new String( 1 .. Current_Max_Line_Length =
);
end;
end loop;
Ada.Text_IO.Close( Handle );
-- Construct the Huffman tree using these characters and
-- weights:
TheTree :=3D Build_Huffman_Tree( Encode_Freq_Array );
exception
when Ada.Text_IO.NAME_ERROR =3D>
Ada.Text_IO.Put_Line
( "Error in call to Encode_File: the file " & Input_File &
" was not found." );
end Encode_File;
------------------
-- Find_Pattern --
------------------
function Find_Pattern
(Char : Character)
return String
is
begin
return Find_Pattern (Char);
end Find_Pattern;
----------------------------------
-- Find_Tree_Of_Smallest_Weight --
----------------------------------
-- Return the tree whose weight is minimum among all of the trees
-- in the parameter Tree_List. We will be invoking this function
-- twice consecutively to find the two such smallest trees, so in
-- order to avoid returning the same tree twice, we mark the
-- smallest tree prior to its return by changing its Considered
-- field to True.
function Find_Tree_Of_Smallest_Weight
(Tree_List : Tree_List_Pack.List)
return Huffman_Tree
is
Result : Huffman_Tree :=3D null;
Tree : Huffman_Tree :=3D null;
Tree_Pointer : Tree_List_Pack.Position;
begin
-- This is just an O(n) search through the whole list for the
-- one with smallest weight. Start with the head of the list:
Tree_Pointer :=3D Tree_List_Pack.First( Tree_List );
Result :=3D Tree_List_Pack.Retrieve( Tree_Pointer );
Tree :=3D Result;
while not Tree_List_Pack.Is_Last( Tree_Pointer, Tree_List ) loop
-- Point to the next item in the list:
Tree_List_Pack.Advance( Tree_Pointer, Tree_List );
Tree :=3D Tree_List_Pack.Retrieve( Tree_Pointer );
-- If it hasn't previously been considered as a minimum, test
-- to see if it's got the smallest weight that we've seen so =
far:
if not Tree.Considered then
if Tree.Weight < Result.Weight then
Result :=3D Tree;
end if;
end if;
end loop;
Result.Considered :=3D True;
return Result;
end Find_Tree_Of_Smallest_Weight;
-----------------
-- Merge_Trees --
-----------------
procedure Merge_Trees
(Tree1, Tree2 : in out Huffman_Tree;
Tree_List : in out Tree_List_Pack.List)
is
begin
null;
end Merge_Trees;
------------------------
-- Print_Huffman_Tree --
------------------------
procedure Print_Huffman_Tree
(Tree1 : in Huffman_Tree;
File : in out Ada.Text_IO.File_Type)
is
begin
null;
end Print_Huffman_Tree;
end Huffman_Tree;
------_=_NextPart_000_01C1EA42.0D7C8510
Content-Type: application/octet-stream;
name="huffman_tree.ads"
Content-Disposition: attachment;
filename="huffman_tree.ads"
with Ada.Text_IO;
with Linked_List3;
package Huffman_Tree is
type Frequency_Array is array(Character) of Natural;
type String_Ptr is access String;
type Bit_Pattern_Array is array(Character) of String_Ptr;
type Huffman_Record;
type Huffman_Tree is access Huffman_Record;
type Huffman_Record is record
Char : Character := '@';
Weight : Natural := 0;
Left : Huffman_Tree := null;
Right : Huffman_Tree := null;
Considered : Boolean := False;
end record;
package Tree_List_Pack is new Linked_List3(Huffman_Tree, "=");
procedure Accumulate_Character_Frequencies
(Text : in String;
Freq_Array : in out Frequency_Array);
function Find_Tree_Of_Smallest_Weight
(Tree_List : Tree_List_Pack.List) return Huffman_Tree;
procedure Merge_Trees
(Tree1, Tree2 : in out Huffman_Tree;
Tree_List : in out Tree_List_Pack.List);
function Build_Huffman_Tree
(Freq_Array : Frequency_Array) return Huffman_Tree;
procedure Print_Huffman_Tree
(Tree1 : in Huffman_Tree;
File : in out Ada.Text_IO.File_Type );
function Find_Pattern
(Char : Character) return String;
procedure Encode_File(Input_File : String);
procedure DecodeFile(Input_File : String );
end Huffman_Tree;
------_=_NextPart_000_01C1EA42.0D7C8510
Content-Type: application/octet-stream;
name="linked_list3.adb"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
filename="linked_list3.adb"
with Ada.Text_IO;
use Ada.Text_IO;
with Unchecked_Deallocation;
-- This implementation uses a header node
-- Thus Initialize and Finalize must be defined
package body Linked_List3 is
procedure TraverseList( L : List ) is
P: Position :=3D L.Header.Next;
begin
while P /=3D null loop
ProcessOneElement( P.Element );
P :=3D P.Next;
end loop;
end TraverseList;
-- Advance P to the next node
-- Note that L is unused in this implementation
procedure Advance( P: in out Position; L: List ) is
begin
if P =3D null then
raise Advanced_Past_End;
else
P :=3D P.Next;
end if;
end Advance;
procedure Dispose is new Unchecked_Deallocation( Node, Position );
-- Return position of X in L
-- Raise Item_Not_Found if appropriate
function Find( X: Element_Type; L: List ) return Position is
P: Position :=3D L.Header.Next;
begin
while P /=3D null and then P.Element /=3D X loop
P :=3D P.Next;
end loop;
if P =3D null then
raise Item_Not_Found;
end if;
return P;
end Find;
-- Return position prior to X in L
-- Raise Item_Not_Found if appropriate
-- Here we use a trick: we don't test for
-- a null pointer, but instead catch the
-- constraint_error that results from
-- dereferencing it
function Find_Previous( X: Element_Type; L: List ) return Position =
is
P: Position :=3D L.Header;
begin
while P.Next.Element /=3D X loop
P :=3D P.Next;
end loop;
return P;
exception
when Constraint_Error =3D>
raise Item_Not_Found;
end Find_Previous;
-- Return first position in list L
function First( L: List ) return Position is
begin
return L.Header.Next;
end First;
-- Return true if X is in list L; false otherwise
-- The algorithm is to perform a Find, and if the
-- Find fails, an exception will be raised.
function In_List( X: Element_Type; L: List ) return Boolean is
P : Position;
begin
P :=3D Find( X, L );
return True;
exception
when Item_Not_Found =3D>
return False;
end In_List;
-- Insert after Position P
-- Note that L is unused
procedure Insert( X: Element_Type; L: in out List; P: Position ) is
begin
if P =3D null then
raise Item_Not_Found;
else
P.Next :=3D new Node'( X, P.Next );
end if;
L.Num_Elements :=3D L.Num_Elements + 1;
end Insert;
-- Insert X as the first element in list L
procedure Insert_As_First_Element( X: Element_Type; L: in out List =
) is
begin
-- Check to make sure that the list has been intialized:
if L.Header =3D null then
Put_Line( Standard_Error,
"Error in call to Insert_As_First_Element: " &
"you forgot to call Make_Empty first!" );
RAISE CONSTRAINT_ERROR;
else
Insert( X, L, L.Header );
end if;
end Insert_As_First_Element;
procedure Insert_As_Last_Element( X: Element_Type; L: in out List ) =
is
P : Position :=3D L.Header;
begin
-- Check to make sure that the list has been intialized:
if L.Header =3D null then
Put_Line( Standard_Error,
"Error in call to Insert_As_Last_Element: " &
"you forgot to call Make_Empty first!" );
RAISE CONSTRAINT_ERROR;
else
-- Find the tail element of the list:
while P.Next /=3D null loop
P :=3D P.Next;
end loop;
-- Perform the insertion here:
Insert( X, L, P );
end if;
end Insert_As_Last_Element;
-- Return true if L is empty; false otherwise
function Is_Empty( L: List ) return Boolean is
begin
return L.Header.Next =3D null;
end Is_Empty;
-- Checks if P is last cell in the list
function Is_Last( P: Position; L: List ) return Boolean is
begin
return P /=3D null and then P.Next =3D null;
end Is_Last;
-- If the List has not been initialized,
-- allocate the header node
-- Otherwise, call Delete_List
procedure Make_Empty( L: in out List ) is
begin
if L.Header =3D null then
L.Header :=3D new Node;
L.Header.Next :=3D null;
else
Delete_List( L );
end if;
end Make_Empty;
-- Return item in Position P
-- Note that L is unused in this implementation
function Retrieve( P: Position; L: List ) return Element_Type is
begin
if P =3D null then
raise Item_Not_Found;
else
return P.Element;
end if;
end Retrieve;
-- Return item in Position P
function Retrieve( P: Position ) return Element_Type is
begin
if P =3D null then
raise Item_Not_Found;
else
return P.Element;
end if;
end Retrieve;
-- Private routine to delete a list
-- This is the routine that Make_Empty calls
procedure Delete_List( L: in out List ) is
P : Position :=3D L.Header.Next;
Temp: Position;
begin
L.Header.Next :=3D null;
while P /=3D null loop
Temp :=3D P.Next;
Dispose( P );
P :=3D Temp;
end loop;
end Delete_List;
function Count
( L : List ) return Natural is
begin
return L.Num_Elements;
end Count;
procedure Delete
( L: in out List; P : in out Position ) is
Temp : Position;
begin
if Is_Empty( L ) then
-- Empty list:
null;
elsif L.Num_Elements =3D 1 then
-- Single-element list:
Dispose( L.Header.Next );
else
-- Find the predecessor of the target:
Temp :=3D L.Header;
while Temp.Next /=3D P loop
Temp :=3D Temp.Next;
end loop;
-- Cause the predecessor to point to target's sucessor:
Temp.Next :=3D Temp.Next.Next;
Dispose( P );
end if;
L.Num_Elements :=3D L.Num_Elements - 1;
end Delete;
end Linked_List3;
------_=_NextPart_000_01C1EA42.0D7C8510
Content-Type: application/octet-stream;
name="linked_list3.ads"
Content-Disposition: attachment;
filename="linked_list3.ads"
-- Generic Package Specification for Linked_Lists
--
generic
type Element_Type is private;
with function "="( Left, Right: Element_Type ) return Boolean;
package Linked_List3 is
type Position is private;
type List is limited private;
procedure Advance( P: in out Position; L: List );
function Find
( X: Element_Type; L: List ) return Position;
function Find_Previous
( X: Element_Type; L: List ) return Position;
function First
( L: List ) return Position;
procedure Insert
( X: Element_Type; L: in out List; P: Position );
procedure Insert_As_First_Element
( X: Element_Type; L: in out List );
procedure Insert_As_Last_Element
( X: Element_Type; L: in out List );
procedure Delete
( L: in out List; P : in out Position );
function Is_Empty
( L: List ) return Boolean;
function Is_Last
( P: Position; L: List ) return Boolean;
procedure Make_Empty
( L: in out List );
function Retrieve
( P: Position; L: List ) return Element_Type;
function Retrieve
( P: Position ) return Element_Type;
function Count
( L : List ) return Natural;
generic
with procedure ProcessOneElement( TheElement : in out Element_Type );
procedure TraverseList( L : List );
Item_Not_Found : exception;
Advanced_Past_End : exception;
private
type Node is
record
Element : Element_Type;
Next : Position;
end record;
type Position is access Node;
type List is record
Header : Position;
Num_Elements : Natural := 0;
end record;
procedure Delete_List( L: in out List );
end Linked_List3;
------_=_NextPart_000_01C1EA42.0D7C8510
Content-Type: application/octet-stream;
name="proj4.adb"
Content-Disposition: attachment;
filename="proj4.adb"
with Ada.Text_IO; use Ada.Text_IO;
with Huffman_Tree;
-- GetChoice
-- DisplayMenu
-- GetFileName
procedure Proj4 is
begin
Huffman_Tree.Encode_File( "thefile.txt" );
end Proj4;
------_=_NextPart_000_01C1EA42.0D7C8510
Content-Type: text/plain;
name="thefile.txt"
Content-Disposition: attachment;
filename="thefile.txt"
Howdy!
------_=_NextPart_000_01C1EA42.0D7C8510--