Object-oriented Software in Ada 95

416 Appendix D
with Unchecked_Deallocation;
package body Class_Queue is
procedure Dispose is
new Unchecked_Deallocation( Node, P_Node );
procedure Add( The:in out Queue; Item:in T ) is
Tmp : P_Node := new Node'( Item, null );
begin
if The.No_Of > 0 then
The.Tail.P_Next := Tmp; --Chain in
else
The.Head := Tmp; --Also head
end if;
The.Tail := Tmp; --New Tail
The.No_Of := The.No_Of + 1; --Inc no.
end Add;
procedure Sub( The:in out Queue; Item :out T ) is
Tmp : P_Node;
begin
if The.No_Of > 0 then
Item := The.Head.Item; --Recovered item
Tmp := The.Head; --Node finished with
The.Head := The.Head.P_Next; --new head
Dispose( Tmp ); --Free storage
The.No_Of := The.No_Of - 1; --1 less in queue
else
raise Queue_Error;
end if;
end Sub;
--Error
procedure Finalize( The:in out Queue ) is
Discard : T;
begin
for I in 1 .. The.No_Of loop --Free storage
Sub( The, Discard );
end loop;
end Finalize;
end Class_Queue;
The instantiation of an integer instance of the class Queue.
with Class_Queue;
package Class_Queue_Int is new Class_Queue(Integer);
A small test program to test the class Queue.
© M A Smith - May not be reproduced without permission