* Specification does not compile
@ 2001-06-04 12:50 daniel gaudry
2001-06-04 22:18 ` Mark Johnson
0 siblings, 1 reply; 3+ messages in thread
From: daniel gaudry @ 2001-06-04 12:50 UTC (permalink / raw)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 14004 bytes --]
--
Daniel.GAUDRY Ph.D.
9 Av CALMELS
92270 Bois Colombes
France
+336 64 19 50 09
Daniel.Gaudry@wanadoo.fr
Daniel.GAUDRY Ph.D.
9 Av CALMELS
92270 Bois Colombes
France
+336 64 19 50 09
Daniel.Gaudry@wanadoo.fr
Please find below specification (w.ads) and corresponding files . I do
not see any error left but cannot have it compiled.
Can somebody please let me know what can be wrong.
Regards
D.GAUDRY
with Poly_Bin_Tree;
package W
is
type Tagged_Record_Type is tagged
record
E : Integer;
end record;
type Tagged_Record_Access_Type is access all Tagged_Record_Type'Class;
function Less(Left, Right : in Tagged_Record_Type'class) return
Boolean;
package Tagged_Bin_Tree_Type is new Poly_Bin_Tree("<"
=> Less,
Tagged_Data_Type
=> Tagged_Record_Type,
Tagged_Data_Access_Type => Tagged_Record_Access_Type);
Bin_Tree : Tagged_Bin_Tree_Type.Bin_Tree_Type;
end W;
--| UNIVERSITY TEACHING CLASS 2001 2002
ADVANCED ADA
--|Daniel.Gaudry@wanadoo.fr
--|
--| d.gaudry May , 21 th 2001
--|
--|
--| needed for > availaility
--|
generic
--|
--| TAGGED TYPE DECLARATION
--|
type Tagged_Data_Type is abstract tagged private;
--|
--|acces to tagged
--|
type Tagged_Data_Access_Type is access all Tagged_Data_Type'Class;
--|
--| for search in the tree
--|
with function "<"(Left, Right : in Tagged_Data_Type'class) return Boolean
is <>;
--|
--|
--|
package Poly_Bin_Tree
is
--|
--| action results
--|
type Result_Code_Type is(Success, Not_Found, Already_There, Is_Full);
--|
--| NODE TYPE DECLARATION
--|
type Bin_Tree_Type is limited private;
--|
--| |�����������������������������������|
--| | Insert |
--| |___________________________________|
--|
procedure Insert(In_The_Tree : in out Bin_Tree_Type;
A_Data : in Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type);
--|
--| |�����������������������������������|
--| | Update |
--| |___________________________________|
--|
procedure Update(The_Tree : in out Bin_Tree_Type;
With_The_Data : in Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type);
--|
--| |�����������������������������������|
--| | Retrieve |
--| |___________________________________|
--|
procedure Retrieve(In_The_Tree : in out Bin_Tree_Type;
A_Data : in out Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type);
--|
--| |�����������������������������������|
--| | Delete |
--| |___________________________________|
--|
procedure Delete(In_The_Tree : in out Bin_Tree_Type;
A_Data : in Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type);
--|
--|
--|
private
--|
--|
--|
type Node_Type;
--|
--|
--|
type Bin_Tree_Type is access Node_Type;
--|
--|
--|
type Node_Type is
record
Left : Bin_Tree_Type;
Right : Bin_Tree_Type;
The_Data : Tagged_Data_Access_Type := null;
end record;
end Poly_Bin_Tree;
--| UNIVERSITY TEACHING CLASS 2001 2002
ADVANCED ADA
--|Daniel.Gaudry@wanadoo.fr
--|
--| d.gaudry May , 21 th 2001
package body Poly_Bin_Tree
is
type Search_Result_Type is(Found,
Null_Tree,
Left,
Right);
--|
--| |==================================|
--| | Search |
--| |==================================|
--|
procedure Search(In_The_Tree : in out Bin_Tree_Type;
A_Data : in Tagged_Data_Type'Class;
Result_Tree : out Bin_Tree_Type;
Search_Result : out Search_Result_Type)
is
Current_Subtree : Bin_Tree_Type := In_The_Tree;
Local_Tree : Bin_Tree_Type;
Result : Search_Result_Type;
begin
--|
--|
--|
if In_The_Tree /= null
then
--|
--|
--|
loop
--|
--|
--|
Local_Tree := Current_Subtree;
--|
--|
--|
if Current_Subtree.The_Data.all < A_Data
then
Result := Right;
Current_Subtree := Current_Subtree.Right;
--|
--|
--|
elsif A_Data < Current_Subtree.The_Data.all
then
Result := Left;
Current_Subtree := Current_Subtree.Left;
--|
--|
--|
else
Result := Found;
exit;
end if;
--|
--|
--|
exit when Current_Subtree = null;
end loop;
--|
--|
--|
Result_Tree := Local_Tree;
Search_Result := Result;
else
--|
--|
--|
Search_Result := Null_Tree;
end if;
end Search;
--|
--| |==================================|
--| | Retrieve |
--| |==================================|
--|
procedure Retrieve(In_The_Tree : in out Bin_Tree_Type;
A_Data : in out Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type)
is
Temporary_Tree : Bin_Tree_Type;
Search_Result : Search_Result_Type;
begin
--|
--|
--|
Search(In_The_Tree => In_The_Tree,
A_Data => A_Data,
Result_Tree => Temporary_Tree,
Search_Result => Search_Result);
--|
--|
--|
if Search_Result = Found
then
A_Data := Temporary_Tree.The_Data.all;
Result_Code := Success;
else
--|
--|
--|
Result_Code := Not_Found;
end if;
end Retrieve;
--|
--| |==================================|
--| | Update |
--| |==================================|
--|
procedure Update(The_Tree : in out Bin_Tree_Type;
With_The_Data : in Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type)
is
Temporary_Tree : Bin_Tree_Type;
Search_Result : Search_Result_Type;
begin
--|
--|
--|
Search(In_The_Tree => The_Tree,
A_Data => With_The_Data,
Result_Tree => Temporary_Tree,
Search_Result => Search_Result);
--|
--|
--|
if Search_Result = Found
then
Temporary_Tree.The_Data.all :=
Tagged_Data_Type'Class'(with_The_Data);
Result_Code := Success;
else
Result_Code := Not_Found;
end if;
end Update;
--|
--| |�����������������������������������|
--| | Insert |
--| |___________________________________|
--|
procedure Insert(In_The_Tree : in out Bin_Tree_Type;
A_Data : in Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type)
is
Temporary_Tree : Bin_Tree_Type;
Search_Result : Search_Result_Type;
begin
--|
--|
--|
Search(In_The_Tree => In_The_Tree,
A_Data => A_Data,
Result_Tree => Temporary_Tree,
Search_Result => Search_Result);
--|
--|
--|
case Search_Result is
--|
--|
--|
when Found =>
Result_Code := Already_There;
return;
--|
--|
--|
when Null_Tree =>
In_The_Tree := new Node_Type'(left => null,
Right => null,
The_Data => new
Tagged_Data_Type'Class'(a_Data));
--|
--|
--|
when Left =>
Temporary_Tree.Left := new Node_Type'(left => null,
Right => null,
The_Data => new
Tagged_Data_Type'Class'(a_Data));
--|
--|
--|
when Right =>
Temporary_Tree.Right := new Node_Type'(left => null,
Right => null,
The_Data => new
Tagged_Data_Type'Class'(a_Data));
end case;
--|
--|
--|
Result_Code := Success;
--|
--|
--|
exception
when Storage_Error =>
Result_Code := Is_Full;
end Insert;
--|
--| |==================================|
--| | Delete |
--| |==================================|
--|
procedure Delete(In_The_Tree : in out Bin_Tree_Type;
A_Data : in Tagged_Data_Type'Class;
Result_Code : out Result_Code_Type)
is
--|
--|
--|
type Delete_Direction_Type is
(Top,
Left,
Right);
Local_Tree : Bin_Tree_Type;
Temporary_Tree : Bin_Tree_Type := In_The_Tree;
Delete_Direction : Delete_Direction_Type := Top;
--|
--| |==================================|
--| | Node_Delete |
--| |==================================|
--|
function Node_Delete(From_The_Tree : in Bin_Tree_Type) return
Bin_Tree_Type
is
Temporary_Tree : Bin_Tree_Type;
begin
--|
--|
--|
if From_The_Tree.Left = null
then
return From_The_Tree.Right;
--|
--|
--|
else
Temporary_Tree := From_The_Tree.Left;
--|
--|
--|
while Temporary_Tree.Right /= null loop
Temporary_Tree := Temporary_Tree.Right;
end loop;
--|
--|
--|
Temporary_Tree.Right := From_The_Tree.Right;
return From_The_Tree.Left;
end if;
end Node_Delete;
--|
--| |==================================|
--| | MAIN Delete |
--| |==================================|
--|
begin
--|
--|
--|
loop
--|
--|
--|
if Temporary_Tree = null
then
Result_Code := Not_Found;
return;
--|
--|
--|
elsif Temporary_Tree.The_Data.all < A_Data
then
Local_Tree := Temporary_Tree;
Delete_Direction := Right;
Temporary_Tree := Temporary_Tree.Right;
--|
--|
--|
elsif A_Data < Temporary_Tree.The_Data.all
then
Local_Tree := Temporary_Tree;
Delete_Direction := Left;
Temporary_Tree := Temporary_Tree.Left;
--|
--|
--|
else
Result_Code := Success;
exit;
end if;
end loop;
--|
--|
--|
case Delete_Direction is
--|
--|
--|
when Top =>
In_The_Tree := Node_Delete(From_The_Tree => Temporary_Tree);
--|
--|
--|
when Left =>
Local_Tree.Left := Node_Delete(From_The_Tree => Temporary_Tree);
--|
--|
--|
when Right =>
Local_Tree.Right := Node_Delete(From_The_Tree => Temporary_Tree);
end case;
end Delete;
end Poly_Bin_Tree;
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: Specification does not compile
2001-06-04 12:50 Specification does not compile daniel gaudry
@ 2001-06-04 22:18 ` Mark Johnson
2001-06-04 23:21 ` Keith Thompson
0 siblings, 1 reply; 3+ messages in thread
From: Mark Johnson @ 2001-06-04 22:18 UTC (permalink / raw)
daniel gaudry wrote:
> --
> [snip]
> Daniel.GAUDRY Ph.D.
> 9 Av CALMELS
> 92270 Bois Colombes
> France
> +336 64 19 50 09
> Daniel.Gaudry@wanadoo.fr
>
> Please find below specification (w.ads) and corresponding files . I do
> not see any error left but cannot have it compiled.
> Can somebody please let me know what can be wrong.
>
I assume you are using gnat to isolate the problem. Also - if you post code in
the future, try using attachments. The copy I got had several of the comment
lines wrapped (which broke the program...)
> [snip]
> if Search_Result = Found
> then
> Temporary_Tree.The_Data.all :=
> Tagged_Data_Type'Class'(with_The_Data);
> Result_Code := Success;
> else
> Result_Code := Not_Found;
> end if;
The compiler complains about the statement...
Temporary_Tree.The_Data.all := Tagged_Data_Type'Class'(with_The_Data);
with the following error message...
w.ads:19:06: instantiation error at poly_bin_tree.adb:148
w.ads:19:06: controlling argument is not dynamically tagged
which can be simplified to...
Temporary_Tree.The_Data.all := with_The_Data;
which compiles OK. I am not quite sure why the qualified expression didn't
work.
--Mark
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: Specification does not compile
2001-06-04 22:18 ` Mark Johnson
@ 2001-06-04 23:21 ` Keith Thompson
0 siblings, 0 replies; 3+ messages in thread
From: Keith Thompson @ 2001-06-04 23:21 UTC (permalink / raw)
Mark Johnson <mark_h_johnson@raytheon.com> writes:
[...]
> I assume you are using gnat to isolate the problem. Also - if you
> post code in the future, try using attachments. The copy I got had
> several of the comment lines wrapped (which broke the program...)
[...]
Actually, attachments on Usenet are usually a bad idea; not everyone
uses a newsreader that can handle them. If you're going to post code,
it's usually better to post a small sample.
It should also be possible to configure your news posting program so
it doesn't wrap long lines.
--
Keith Thompson (The_Other_Keith) kst@cts.com <http://www.ghoti.net/~kst>
San Diego Supercomputer Center <*> <http://www.sdsc.edu/~kst>
Cxiuj via bazo apartenas ni.
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2001-06-04 23:21 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2001-06-04 12:50 Specification does not compile daniel gaudry
2001-06-04 22:18 ` Mark Johnson
2001-06-04 23:21 ` Keith Thompson
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox