From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: * X-Spam-Status: No, score=1.4 required=5.0 tests=BAYES_00,FROM_WORDY, PP_MIME_FAKE_ASCII_TEXT,XPRIO autolearn=no autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII X-Google-Thread: 103376,a23f8a36ba44aa8b,start X-Google-Attributes: gid103376,public X-Google-ArrivalTime: 2001-06-04 05:48:45 PST Path: archiver1.google.com!newsfeed.google.com!sn-xit-02!supernews.com!isdnet!wanadoo.fr!not-for-mail From: "daniel gaudry" Newsgroups: comp.lang.ada Subject: Specification does not compile Date: Mon, 4 Jun 2001 14:50:24 +0200 Organization: Wanadoo, l'internet avec France Telecom Message-ID: <9fg03c$pmq$2@wanadoo.fr> NNTP-Posting-Host: aputeaux-102-1-6-180.abo.wanadoo.fr X-Trace: wanadoo.fr 991658924 26330 193.253.62.180 (4 Jun 2001 12:48:44 GMT) X-Complaints-To: abuse@wanadoo.fr NNTP-Posting-Date: 4 Jun 2001 12:48:44 GMT X-Priority: 3 X-MSMail-Priority: Normal X-Newsreader: Microsoft Outlook Express 6.00.2462.0000 X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2462.0000 Xref: archiver1.google.com comp.lang.ada:8058 Date: 2001-06-04T12:48:44+00:00 List-Id: -- 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;