Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 310 lines (271 sloc) 9.798 kb
de755db0 »
2012-07-31 put everything into their own modules
1 use v6;
2 use Test;
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
3 use Game::Hanoi;
de755db0 »
2012-07-31 put everything into their own modules
4
5 sub throws_exception(&code, $ex_type, $message, &followup = {;}) {
6 &code();
7 ok 0, $message;
8 if &followup {
9 diag 'Not running followup because an exception was not triggered';
10 }
11 CATCH {
12 default {
13 ok 1, $message;
14 my $type_ok = $_.WHAT === $ex_type;
15 ok $type_ok , "right exception type ({$ex_type.^name})";
16 if $type_ok {
17 &followup($_);
18 } else {
19 diag "Got: {$_.WHAT.gist}\n"
20 ~"Expected: {$ex_type.gist}";
21 diag "Exception message: $_.message()";
22 diag 'Not running followup because type check failed';
23 }
24 }
25 }
26 }
27
28 {
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
29 my $game = Game::Hanoi.new();
de755db0 »
2012-07-31 put everything into their own modules
30
31 is $game.move('left', 'middle'),
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
32 Game::Hanoi::DiskMoved.new(
de755db0 »
2012-07-31 put everything into their own modules
33 :disk('tiny disk'),
34 :source<left>,
35 :target<middle>
36 ),
37 'moving a disk (+)';
38
39 throws_exception
40 { $game.move('left', 'middle') },
41 X::Hanoi::LargerOnSmaller,
42 'moving a disk (-) larger disk on smaller',
43 {
44 is .larger, 'small disk', '.larger attribute';
45 is .smaller, 'tiny disk', '.smaller attribute';
46 is .message,
47 'Cannot put the small disk on the tiny disk',
48 '.message attribute';
49 };
50
51 throws_exception
52 { $game.move('gargle', 'middle') },
53 X::Hanoi::NoSuchRod,
54 'moving a disk (-) no such source rod',
55 {
56 is .rod, 'source', '.rod attribute';
57 is .name, 'gargle', '.name attribute';
58 is .message,
59 q[No such source rod 'gargle'],
60 '.message attribute';
61 };
62
63 throws_exception
64 { $game.move('middle', 'clown') },
65 X::Hanoi::NoSuchRod,
66 'moving a disk (-) no such target rod',
67 {
68 is .rod, 'target', '.rod attribute';
69 is .name, 'clown', '.name attribute';
70 is .message,
71 q[No such target rod 'clown'],
72 '.message attribute';
73 };
74
75 throws_exception
76 { $game.move('right', 'middle') },
77 X::Hanoi::RodHasNoDisks,
78 'moving a disk (-) rod has no disks',
79 {
80 is .name, 'right', '.name attribute';
81 is .message,
82 q[Cannot move from the right rod because there is no disk there],
83 '.message attribute';
84 };
85 }
86
87 {
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
88 my $game = Game::Hanoi.new();
de755db0 »
2012-07-31 put everything into their own modules
89
90 multi hanoi_moves($source, $, $target, 1) {
91 # A single disk, easy; just move it directly.
92 $source, 'to', $target
93 }
94 multi hanoi_moves($source, $helper, $target, $n) {
95 # $n-1 disks on to; move them off to the $helper rod first...
96 hanoi_moves($source, $target, $helper, $n-1),
97 # ...then move over the freed disk at the bottom...
98 hanoi_moves($source, $helper, $target, 1),
99 # ...and finally move the rest from $helper to $target.
100 hanoi_moves($helper, $source, $target, $n-1)
101 }
102
103 # Let's play out the thing to the end. 32 moves.
104 my @moves = hanoi_moves("left", "middle", "right", 5);
105 # RAKUDO: .splice doesn't do WhateverCode yet: wanted *-3
106 my @last_move = @moves.splice(@moves.end-2);
107
108 lives_ok {
109 for @moves -> $source, $, $target {
110 my ($event, @rest) = $game.move($source, $target);
111 die "Unexpected event type: {$event.name}"
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
112 unless $event ~~ Game::Hanoi::DiskMoved;
de755db0 »
2012-07-31 put everything into their own modules
113 die "Unexpected extra events: @rest"
114 if @rest;
115 }
116 }, 'making all the moves to the end of the game works';
117
118 {
119 my ($source, $, $target) = @last_move;
120 is $game.move($source, $target), (
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
121 Game::Hanoi::DiskMoved.new(:disk('tiny disk'), :$source, :$target),
122 Game::Hanoi::AchievementUnlocked.new(),
de755db0 »
2012-07-31 put everything into their own modules
123 ), 'putting all disks on the right rod unlocks achievement';
124
125 $game.move($target, $source);
126 is $game.move($source, $target), (
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
127 Game::Hanoi::DiskMoved.new(:disk('tiny disk'), :$source, :$target),
de755db0 »
2012-07-31 put everything into their own modules
128 ), 'moving things back and forth does not unlock achievement again';
129 }
130
131 {
132 $game.move('right', 'middle');
133 is $game.move(my $source = 'right', my $target = 'left'), (
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
134 Game::Hanoi::DiskMoved.new(:disk('small disk'), :$source, :$target),
135 Game::Hanoi::AchievementLocked.new(),
de755db0 »
2012-07-31 put everything into their own modules
136 ), 'removing two disks from the right rod locks achievement';
137 }
138
139 {
140 $game.move('left', 'right');
141 $game.remove('tiny disk');
142 is $game.add(my $disk = 'tiny disk', my $target = 'right'), (
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
143 Game::Hanoi::DiskAdded.new(:$disk, :$target),
144 Game::Hanoi::AchievementUnlocked.new(),
de755db0 »
2012-07-31 put everything into their own modules
145 ), 'you can also unlock achievement by adding the disk';
146 }
147 }
148
149 {
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
150 my $game = Game::Hanoi.new();
de755db0 »
2012-07-31 put everything into their own modules
151
152 is $game.move('tiny disk', my $target = 'middle'),
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
153 Game::Hanoi::DiskMoved.new(:disk('tiny disk'), :source<left>, :$target),
de755db0 »
2012-07-31 put everything into their own modules
154 'naming source disk instead of the rod (+)';
155 }
156
157 {
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
158 my $game = Game::Hanoi.new();
de755db0 »
2012-07-31 put everything into their own modules
159
160 throws_exception
161 { $game.move('large disk', 'right') },
162 X::Hanoi::CoveredDisk,
163 'naming source disk instead of the rod (-)',
164 {
165 is .disk, 'large disk', '.disk attribute';
166 is .covered_by, ['medium disk', 'small disk', 'tiny disk'],
167 '.covered_by attribute';
168 is .message,
169 'Cannot move the large disk: it is covered by '
170 ~ 'the medium disk, the small disk, and the tiny disk',
171 '.message attribute';
172 };
173 }
174
175 {
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
176 my $game = Game::Hanoi.new();
de755db0 »
2012-07-31 put everything into their own modules
177
178 throws_exception
179 { $game.move('small disk', 'right') },
180 X::Hanoi::CoveredDisk,
181 'naming source disk instead of the rod (-) no and for one-item lists',
182 {
183 is .message,
184 'Cannot move the small disk: it is covered by the tiny disk',
185 '.message attribute';
186 };
187 }
188
189 {
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
190 my $game = Game::Hanoi.new();
de755db0 »
2012-07-31 put everything into their own modules
191
192 is $game.remove('tiny disk'),
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
193 Game::Hanoi::DiskRemoved.new(:disk('tiny disk'), :source<left>),
de755db0 »
2012-07-31 put everything into their own modules
194 'removing a disk (+)';
195
196 throws_exception
197 { $game.remove('small disk') },
198 X::Hanoi::ForbiddenDiskRemoval,
199 'removing a disk (-) removing disk is forbidden',
200 {
201 is .disk, 'small disk', '.disk attribute';
202 is .message,
203 'Removing the small disk is forbidden',
204 '.message attribute';
205 };
206
207 throws_exception
208 { $game.remove('medium disk') },
209 X::Hanoi::CoveredDisk,
210 'removing a disk (-) the disk is covered',
211 {
212 is .disk, 'medium disk', '.disk attribute';
213 is .covered_by, ['small disk'],
214 '.covered_by attribute';
215 };
216
217 $game.move('small disk', 'middle');
218 { $game.remove('medium disk') },
219 X::Hanoi::ForbiddenDiskRemoval,
220 'removing a disk (-) uncovered, removal is still forbidden',
221 {
222 is .disk, 'medium disk', '.disk attribute';
223 };
224 }
225
226 {
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
227 my $game = Game::Hanoi.new();
de755db0 »
2012-07-31 put everything into their own modules
228
229 $game.remove('tiny disk');
230
231 throws_exception
232 { $game.remove('tiny disk') },
233 X::Hanoi::DiskHasBeenRemoved,
234 'removing a disk (-) the disk had already been removed',
235 {
236 is .disk, 'tiny disk', '.disk attribute';
237 is .action, 'remove', '.action attribute';
238 is .message,
239 'Cannot remove the tiny disk because it has been removed',
240 '.message attribute';
241 };
242
243 throws_exception
244 { $game.move('tiny disk', 'middle') },
245 X::Hanoi::DiskHasBeenRemoved,
246 'moving a disk (-) the disk had already been removed',
247 {
248 is .disk, 'tiny disk', '.disk attribute';
249 is .action, 'move', '.action attribute';
250 is .message,
251 'Cannot move the tiny disk because it has been removed',
252 '.message attribute';
253 };
254
255 throws_exception
256 { $game.add('tiny disk', 'pineapple') },
257 X::Hanoi::NoSuchRod,
258 'moving a disk (-) the rod does not exist',
259 {
260 is .rod, 'target', '.rod attribute';
261 is .name, 'pineapple', '.name attribute';
262 };
263
264 is $game.add('tiny disk', 'left'),
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
265 Game::Hanoi::DiskAdded.new(:disk('tiny disk'), :target<left>),
de755db0 »
2012-07-31 put everything into their own modules
266 'adding a disk (+)';
267
268 throws_exception
269 { $game.add('humongous disk', 'middle') },
270 X::Hanoi::NoSuchDisk,
271 'adding a disk (-) there is no such disk',
272 {
273 is .action, 'add', '.action attribute';
274 is .disk, 'humongous disk', '.disk attribute';
275 is .message,
276 'Cannot add a humongous disk because there is no such disk',
277 '.message attribute';
278 };
279
280 throws_exception
281 { $game.add('tiny disk', 'right') },
282 X::Hanoi::DiskAlreadyOnARod,
283 'adding a disk (-) the disk is already on a rod',
284 {
285 is .disk, 'tiny disk', '.disk attribute';
286 is .message,
287 'Cannot add the tiny disk because it is already on a rod',
288 '.message attribute';
289 };
290 }
291
292 {
99be19c8 »
2012-08-04 rename Crypt::Game->Game::Crypt, Hanoi::Game->Game::Hanoi
293 my $game = Game::Hanoi.new();
de755db0 »
2012-07-31 put everything into their own modules
294
295 throws_exception
296 { $game.remove('masakian disk') },
297 X::Hanoi::NoSuchDisk,
298 'removing a disk (-) the disk does not exist',
299 {
300 is .action, 'remove', '.action attribute';
301 is .disk, 'masakian disk', '.disk attribute';
302 is .message,
303 'Cannot remove a masakian disk because there is no such disk',
304 '.message attribute';
305 };
306
307 }
308
309 done;
Something went wrong with that request. Please try again.