Object-oriented Software in Ada 95

414 Appendix D
generic
type Store_Index is private; --
type Store_Element is private; --
package Class_Store is
type Store is limited private; --NO copying
Not_There, Full : exception;
procedure Add ( The:in out Store;
Index:in Store_Index;
Item:in Store_Element);
function Deliver( The:in Store;
Index:in Store_Index )
return Store_Element;
private
Max_Store : constant := 10;
type Store_R_Index is range 0 .. Max_Store;
subtype Store_R_Range is Store_R_Index range 1 .. Max_Store;
type Store_Record is record
Index: Store_Index; --Index
Item : Store_Element; --Data item
end record;
type Store_Array is array( Store_R_Range ) of Store_Record;
type Store is limited record
Data : Store_Array;
Items: Store_R_Index := 0;
end record;
end Class_Store;
A possible implementation of the Class Store is:
package body Class_Store is
procedure Add ( The:in out Store;
Index:in Store_Index;
Item:in Store_Element) is
begin
if The.Items < Max_Store then
The.Items := The.Items + 1;
The.Data(The.Items) := ( Index, Item );
else
raise Full;
end if;
end Add;
function Deliver( The:in Store;
Index:in Store_Index)
return Store_Element is
begin
for I in 1 .. Store_R_Range(Max_Store) loop
if The.Data(I).Index = Index then
return The.Data(I).Item;
end if;
end loop;
raise Not_There;
end Deliver;
end Class_Store;
package Pack_Types is
subtype Name is String( 1..5 );
end Pack_Types;
© M A Smith - May not be reproduced without permission