1--  Copyright 1994 Grady Booch
2--  Copyright 1994-1997 David Weller
3--  Copyright 1998-2014 Simon Wright <simon@pushface.org>
4
5--  This package is free software; you can redistribute it and/or
6--  modify it under terms of the GNU General Public License as
7--  published by the Free Software Foundation; either version 2, or
8--  (at your option) any later version. This package is distributed in
9--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
10--  even the implied warranty of MERCHANTABILITY or FITNESS FOR A
11--  PARTICULAR PURPOSE. See the GNU General Public License for more
12--  details. You should have received a copy of the GNU General Public
13--  License distributed with this package; see file COPYING.  If not,
14--  write to the Free Software Foundation, 59 Temple Place - Suite
15--  330, Boston, MA 02111-1307, USA.
16
17with Ada.Exceptions;
18with Ada.Text_IO;
19with BC;
20with Ordered_Queue_Test_Support;
21
22procedure Ordered_Queue_Test is
23   use Ada.Text_IO;
24   use Ordered_Queue_Test_Support;
25   use Containers;
26   use Queues;
27   use QB;
28   use QD;
29   use QU;
30   use QUM;
31
32   procedure Process (C : Character; OK : out Boolean);
33   procedure Process (C : Character; OK : out Boolean) is
34   begin
35      Put_Line ("Item: " & C);
36      OK := True;
37   end Process;
38
39   procedure Assertion (Cond : Boolean; Message : String);
40   procedure Assertion (Cond : Boolean; Message : String) is
41   begin
42      if not Cond then
43         Put_Line (Message);
44      end if;
45   end Assertion;
46
47   procedure Test_Active_Iterator (L : Container'Class);
48   procedure Test_Active_Iterator (L : Container'Class) is
49      Iter : Iterator'Class := New_Iterator (L);
50      Success : Boolean;
51      Temp : Character;
52   begin
53      while not Is_Done (Iter) loop
54         Temp := Current_Item (Iter);
55         Process (Temp, Success);
56         Next (Iter);
57      end loop;
58   end Test_Active_Iterator;
59
60   procedure Test_Primitive (Q1, Q2 : in out Abstract_Ordered_Queue'Class);
61   procedure Test_Primitive (Q1, Q2 : in out Abstract_Ordered_Queue'Class) is
62   begin
63      Assertion (Is_Empty (Q1), "** P01: Queue is not initially empty");
64      Assertion (Length (Q1) = 0,
65                 "** P02: Queue length is not initially zero");
66      Append (Q1, '3');
67      Append (Q1, '2');
68      Append (Q1, '1');
69      Assertion (not (Is_Empty (Q1)), "** P03: Queue is empty");
70      Assertion ((Length (Q1) = 3), "** P04: Queue length is not correct");
71      Assertion ((Front (Q1) = '1'), "** P05: Queue front is not correct");
72      Clear (Q1);
73      Assertion (Is_Empty (Q1), "** P06: Queue is not empty");
74      Assertion ((Length (Q1) = 0), "** P07: Queue length is not zero");
75      Append (Q1, '6');
76      Append (Q1, '5');
77      Append (Q1, '4');
78      Assertion (not (Is_Empty (Q1)), "** P08: Queue is empty");
79      Assertion ((Length (Q1) = 3), "** P09: Queue length is not correct");
80      Assertion ((Front (Q1) = '4'), "** P10: Queue front is not correct");
81      Pop (Q1);
82      Pop (Q1);
83      Assertion (not (Is_Empty (Q1)), "** P11: Queue is empty");
84      Assertion ((Length (Q1) = 1), "** P12: Queue length is not correct");
85      Assertion ((Front (Q1) = '6'), "** P13: Queue front is not correct");
86      Pop (Q1);
87      Assertion (Is_Empty (Q1), "** P14: Queue is not empty");
88      Assertion ((Length (Q1) = 0), "** P15: Queue length is not zero");
89      Append (Q1, '9');
90      Append (Q1, '8');
91      Append (Q1, '7');
92      Pop (Q1);
93      Pop (Q1);
94      Assertion (not (Is_Empty (Q1)), "** P16: Queue is empty");
95      Assertion ((Length (Q1) = 1), "** P17: Queue length is not correct");
96      Assertion ((Front (Q1) = '9'), "** P18: Queue front is not correct");
97      Q2 := Q1;
98      Assertion (not (Is_Empty (Q1)), "** P19: Queue is empty");
99      Assertion ((Length (Q1) = 1), "** P20: Queue length is not correct");
100      Assertion ((Front (Q1) = '9'), "** P21: Queue front is not correct");
101      Assertion (not (Is_Empty (Q2)), "** P22: Queue is empty");
102      Assertion ((Length (Q2) = 1), "** P23: Queue length is not correct");
103      Assertion ((Front (Q2) = '9'), "** P24: Queue front is not correct");
104      Assertion ((Q1 = Q2), "** P25: Queues are not equal");
105      Clear (Q2);
106      Assertion (not (Is_Empty (Q1)), "** P26: Queue is empty");
107      Assertion ((Length (Q1) = 1), "** P27: Queue length is not correct");
108      Assertion ((Front (Q1) = '9'), "** P28: Queue front is not correct");
109      Assertion (Is_Empty (Q2), "** P29: Queue is not empty");
110      Assertion ((Length (Q2) = 0), "** P30: Queue length is not correct");
111      Assertion ((Q1 /= Q2), "** P31: Queues not equal");
112      Append (Q2, '2');
113      Append (Q2, '1');
114      Append (Q2, '3');
115      Append (Q2, '4');
116      Assertion (Location (Q2, '1') = 1,
117                 "** P32: Queue location is not correct");
118      Assertion (Location (Q2, '2') = 2,
119                 "** P33: Queue location is not correct");
120      Assertion (Location (Q2, '4') = 4,
121                 "** P34: Queue location is not correct");
122      Remove (Q2, 1);
123      Remove (Q2, 2);
124      Remove (Q2, 2);
125      Assertion ((Length (Q2) = 1), "** P35: Queue length is not correct");
126      Assertion ((Front (Q2) = '2'), "** P36: Queue front is not correct");
127      Remove (Q2, 1);
128      Assertion ((Length (Q2) = 0), "** P37: Queue length is not correct");
129      Append (Q1, 'z');
130   end Test_Primitive;
131
132   procedure Test_Passive_Iterator (Q : Container'Class);
133   procedure Test_Passive_Iterator (Q : Container'Class) is
134      procedure Iterate is new Visit (Apply => Process);
135      Iter : Iterator'Class := New_Iterator (Q);
136   begin
137      Iterate (Using => Iter);
138   end Test_Passive_Iterator;
139
140   procedure Test_Iterator_Deletion
141     (Q : in out Abstract_Ordered_Queue'Class);
142   procedure Test_Iterator_Deletion
143     (Q : in out Abstract_Ordered_Queue'Class) is
144      Iter : Iterator'Class := New_Iterator (Q);
145      Delete : Boolean;
146   begin
147      Clear (Q);
148      Append (Q, '6');
149      Append (Q, '5');
150      Append (Q, '4');
151      Append (Q, '3');
152      Append (Q, '2');
153      Append (Q, '1');
154      Delete := False;
155      Reset (Iter);
156      while not Is_Done (Iter) loop
157         if Delete then
158            Delete_Item_At (Iter);
159            Delete := False;
160         else
161            Next (Iter);
162            Delete := True;
163         end if;
164      end loop;
165      begin
166         Delete_Item_At (Iter);
167         Assertion (False, "** I01: Deletion succeeded");
168      exception
169         when BC.Not_Found => null;
170         when others =>
171            Assertion (False, "** I02: Unexpected exception");
172      end;
173      Assertion (Length (Q) = 3, "** I03: Queue length is not correct");
174      Assertion (Front (Q) = '1', "** I04: Queue item is not correct");
175      Pop (Q);
176      Assertion (Front (Q) = '3', "** I05: Queue item is not correct");
177      Pop (Q);
178      Assertion (Front (Q) = '5', "** I06: Queue item is not correct");
179      Pop (Q);
180      Assertion (Length (Q) = 0, "** I07: Queue length is not zero");
181   end Test_Iterator_Deletion;
182
183   Queue_B_P1, Queue_B_P2 : QB.Queue;
184   Queue_D_P1, Queue_D_P2 : QD.Queue;
185   Queue_U_P1, Queue_U_P2 : QU.Queue;
186   Queue_UM_P1, Queue_UM_P2 : QUM.Queue;
187
188begin
189   Put_Line ("Starting ordered queue tests");
190
191   Put_Line ("...Bounded Ordered Queue");
192   Test_Primitive (Queue_B_P1, Queue_B_P2);
193
194   Put_Line ("...Dynamic Ordered Queue");
195   QD.Preallocate (Queue_D_P1, 50);
196   Test_Primitive (Queue_D_P1, Queue_D_P2);
197
198   Put_Line ("...Unbounded Ordered Queue");
199   Test_Primitive (Queue_U_P1, Queue_U_P2);
200
201   Put_Line ("...Unmanaged Ordered Queue");
202   Test_Primitive (Queue_UM_P1, Queue_UM_P2);
203
204   Put_Line ("... Ordered Queue Active Iterator");
205   Put_Line ("   Bounded:");
206   Test_Active_Iterator (Queue_B_P1);
207   Put_Line ("   Dynamic:");
208   Test_Active_Iterator (Queue_D_P1);
209   Put_Line ("   Unbounded:");
210   Test_Active_Iterator (Queue_U_P1);
211   Put_Line ("   Unmanaged:");
212   Test_Active_Iterator (Queue_UM_P1);
213
214   Put_Line ("... Ordered Queue Passive Iterator");
215   Put_Line ("   Bounded:");
216   Test_Passive_Iterator (Queue_B_P1);
217   Put_Line ("   Dynamic:");
218   Test_Passive_Iterator (Queue_D_P1);
219   Put_Line ("   Unbounded:");
220   Test_Passive_Iterator (Queue_U_P1);
221   Put_Line ("   Unmanaged:");
222   Test_Passive_Iterator (Queue_UM_P1);
223
224   Assertion ((Front (Queue_B_P1) = '9'),
225              "** M01: Queue front is not correct");
226   Assertion ((Length (Queue_B_P2) = 0),
227              "** M02: Queue length is not correct");
228   Assertion ((Front (Queue_D_P1) = '9'),
229              "** M05: Queue front is not correct");
230   Assertion ((Length (Queue_D_P2) = 0),
231              "** M06: Queue length is not correct");
232   Assertion ((Front (Queue_U_P1) = '9'),
233              "** M09: Queue front is not correct");
234   Assertion ((Length (Queue_U_P2) = 0),
235              "** M10: Queue length is not correct");
236
237   Assertion (Available (Queue_B_P1) = 98,
238              "** M13: Available space not correct");
239   Assertion (Available (Queue_B_P2) = 100,
240              "** M14: Available space not correct");
241
242   Put_Line ("...Ordered Queue Iterator Deletion");
243   Put_Line ("   Bounded:");
244   Test_Iterator_Deletion (Queue_B_P1);
245   Put_Line ("   Dynamic:");
246   Test_Iterator_Deletion (Queue_D_P1);
247   Put_Line ("   Unbounded:");
248   Test_Iterator_Deletion (Queue_U_P1);
249   Put_Line ("   Unmanaged:");
250   Test_Iterator_Deletion (Queue_UM_P1);
251
252   Put_Line ("Completed ordered queue tests");
253
254exception
255   when E : others =>
256      Put_Line ("                                   EXCEPTION "
257                & Ada.Exceptions.Exception_Name (E)
258                & " OCCURRED.");
259end Ordered_Queue_Test;
260