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