1--  Copyright 2001-2014 Simon Wright <simon@pushface.org>
2
3--  This package is free software; you can redistribute it and/or
4--  modify it under terms of the GNU General Public License as
5--  published by the Free Software Foundation; either version 2, or
6--  (at your option) any later version. This package is distributed in
7--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
8--  even the implied warranty of MERCHANTABILITY or FITNESS FOR A
9--  PARTICULAR PURPOSE. See the GNU General Public License for more
10--  details. You should have received a copy of the GNU General Public
11--  License distributed with this package; see file COPYING.  If not,
12--  write to the Free Software Foundation, 59 Temple Place - Suite
13--  330, Boston, MA 02111-1307, USA.
14
15with Ada.Text_IO;
16with BC.Containers.Shellsort;
17with BC.Containers.Quicksort;
18with Collection_Test_Support;
19
20procedure Sort_Test is
21
22   use Ada.Text_IO;
23   use Collection_Test_Support;
24   use Containers;
25
26   procedure Add (To : in out CB.Collection; S : String);
27   procedure Print (C : Container'Class);
28
29   procedure Print (C : Container'Class) is
30      procedure Process (C : Character; OK : out Boolean);
31      procedure Process (C : Character; OK : out Boolean) is
32      begin
33         Put (C);
34         OK := True;
35      end Process;
36      procedure Iterate is new Visit (Apply => Process);
37      Iter : Iterator'Class := New_Iterator (C);
38   begin
39      Put ("|");
40      Iterate (Using => Iter);
41      Put_Line ("|");
42   end Print;
43
44   procedure SSort is new Containers.Shellsort
45     (Container => CB.Collection,
46      Length => CB.Length);
47
48   procedure Reverse_SSort is new Containers.Shellsort
49     (Container => CB.Collection,
50        "<" => ">",
51      Length => CB.Length);
52
53   procedure QSort is new Containers.Quicksort
54     (Container => CB.Collection,
55      Length => CB.Length);
56
57   procedure Reverse_QSort is new Containers.Quicksort
58     (Container => CB.Collection,
59        "<" => ">",
60      Length => CB.Length);
61
62   C : CB.Collection;
63
64   procedure Add (To : in out CB.Collection; S : String) is
65   begin
66      for Ch in S'Range loop
67         CB.Append (To, S (Ch));
68      end loop;
69   end Add;
70
71begin
72
73   Put_Line ("Shellsort:");
74
75   CB.Clear (C);
76
77   Add (C, "holy_moses");
78   SSort (C);
79   Print (C);
80   Reverse_SSort (C);
81   Print (C);
82
83   New_Line;
84
85   Add (C, "take_a_look");
86   SSort (C);
87   Print (C);
88   Reverse_SSort (C);
89   Print (C);
90
91   New_Line;
92   Put_Line ("equal keys, starting from empty");
93
94   CB.Clear (C);
95   SSort (C);
96   Print (C);
97
98   Add (C, "a");
99   SSort (C);
100   Print (C);
101
102   Add (C, "a");
103   SSort (C);
104   Print (C);
105
106   Add (C, "a");
107   SSort (C);
108   Print (C);
109
110   Add (C, "a");
111   SSort (C);
112   Print (C);
113
114   New_Line;
115   Put_Line ("length 2");
116   CB.Clear (C);
117   Add (C, "b");
118   Add (C, "a");
119   SSort (C);
120   Print (C);
121   Reverse_SSort (C);
122   Print (C);
123
124   New_Line;
125
126   Put_Line ("Quicksort:");
127
128   CB.Clear (C);
129
130   Add (C, "holy_moses");
131   QSort (C);
132   Print (C);
133   Reverse_QSort (C);
134   Print (C);
135
136   New_Line;
137
138   Add (C, "take_a_look");
139   QSort (C);
140   Print (C);
141   Reverse_QSort (C);
142   Print (C);
143
144   New_Line;
145   Put_Line ("equal keys, starting from empty");
146
147   CB.Clear (C);
148   QSort (C);
149   Print (C);
150
151   Add (C, "a");
152   QSort (C);
153   Print (C);
154
155   Add (C, "a");
156   QSort (C);
157   Print (C);
158
159   Add (C, "a");
160   QSort (C);
161   Print (C);
162
163   Add (C, "a");
164   QSort (C);
165   Print (C);
166
167   New_Line;
168   Put_Line ("length 2");
169   CB.Clear (C);
170   Add (C, "b");
171   Add (C, "a");
172   QSort (C);
173   Print (C);
174   Reverse_QSort (C);
175   Print (C);
176
177end Sort_Test;
178