1--  Copyright 1994 Grady Booch
2--  Copyright 2005 Martin Krischik
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
17--  As a special exception, if other files instantiate generics from
18--  this unit, or you link this unit with other files to produce an
19--  executable, this unit does not by itself cause the resulting
20--  executable to be covered by the GNU General Public License.  This
21--  exception does not however invalidate any other reasons why the
22--  executable file might be covered by the GNU Public License.
23
24with System;
25
26package body BC.Indefinite_Containers.Collections is
27
28   function Are_Equal
29     (Left, Right : Abstract_Collection'Class) return Boolean is
30   begin
31      if System."=" (Left'Address, Right'Address) then
32         return True;
33      end if;
34      if Length (Left) /= Length (Right) then
35         return False;
36      end if;
37      declare
38         Left_Iter : Iterator'Class := New_Iterator (Left);
39         Right_Iter : Iterator'Class := New_Iterator (Right);
40      begin
41         while not Is_Done (Left_Iter) and then
42           not Is_Done (Right_Iter) loop
43            if Current_Item (Left_Iter) /= Current_Item (Right_Iter) then
44               return False;
45            end if;
46            Next (Left_Iter);
47            Next (Right_Iter);
48         end loop;
49         return True;
50      end;
51   end Are_Equal;
52
53   procedure Copy (From : Abstract_Collection'Class;
54                   To : in out Abstract_Collection'Class) is
55      Iter : Iterator'Class := New_Iterator (From);
56   begin
57      if System."/=" (From'Address, To'Address) then
58         Clear (To);
59         Reset (Iter);
60         while not Is_Done (Iter) loop
61            --  doing Append will preserve ordering of equal-key items
62            --  in Ordered Collections.
63            Append (To, Current_Item (Iter));
64            Next (Iter);
65         end loop;
66      end if;
67   end Copy;
68
69   function Available (C : Abstract_Collection) return Natural is
70      pragma Warnings (Off, C);
71   begin
72      return Natural'Last;
73   end Available;
74
75   procedure Reset (It : in out Collection_Iterator) is
76      C : Abstract_Collection'Class
77        renames Abstract_Collection'Class (It.For_The_Container.all);
78   begin
79      if Length (C) = 0 then
80         It.Index := 0;
81      else
82         It.Index := 1;
83      end if;
84   end Reset;
85
86   function Is_Done (It : Collection_Iterator) return Boolean is
87      C : Abstract_Collection'Class
88     renames Abstract_Collection'Class (It.For_The_Container.all);
89   begin
90      return It.Index = 0 or else It.Index > Length (C);
91   end Is_Done;
92
93   procedure Next (It : in out Collection_Iterator) is
94   begin
95      It.Index := It.Index + 1;
96   end Next;
97
98   function Current_Item (It : Collection_Iterator) return Item is
99      C : Abstract_Collection'Class
100     renames Abstract_Collection'Class (It.For_The_Container.all);
101   begin
102      if Is_Done (It) then
103         raise BC.Not_Found;
104      end if;
105      return Item_At (C, It.Index).all;
106   end Current_Item;
107
108   function Current_Item_Ptr (It : Collection_Iterator) return Item_Ptr is
109      C : Abstract_Collection'Class
110     renames Abstract_Collection'Class (It.For_The_Container.all);
111   begin
112      if Is_Done (It) then
113         raise BC.Not_Found;
114      end if;
115      return Item_At (C, It.Index);
116   end Current_Item_Ptr;
117
118   procedure Delete_Item_At (It : in out Collection_Iterator) is
119      C : Abstract_Collection'Class
120        renames Abstract_Collection'Class (It.For_The_Container.all);
121   begin
122      if Is_Done (It) then
123         raise BC.Not_Found;
124      end if;
125      Remove (C, It.Index);
126   end Delete_Item_At;
127
128end BC.Indefinite_Containers.Collections;
129