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