Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 599 lines (522 sloc) 18.844 kb
bb828fb @masak [crypt.pl -> bin/crypt] rename
authored
1 #! /usr/local/bin/nom
2
35435dc @masak [crypt.pl] hanoi game, legal move
authored
3 use Test;
4
5 role Event {
6 method Str {
7 sub event() { self.^name }
8 sub name($attr) { $attr.name.substr(2) }
9 sub value($attr) { $attr.get_value(self) }
10
11 "{event}[{map { ":{name $_}<{value $_}>" }, self.^attributes}]"
12 }
13 }
14
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
15 class Hanoi::DiskMoved does Event {
0f569fa @masak [crypt.pl] size -> disk refactor
authored
16 has $.disk;
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
17 has $.source;
18 has $.target;
19 }
20
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
21 class Hanoi::AchievementUnlocked does Event {
35435dc @masak [crypt.pl] hanoi game, legal move
authored
22 }
23
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
24 class Hanoi::AchievementLocked does Event {
96d9cf3 @masak [crypt.pl] achievements can be locked, too
authored
25 }
26
a47664c @masak [crypt.pl] can remove disks
authored
27 class Hanoi::DiskRemoved does Event {
0f569fa @masak [crypt.pl] size -> disk refactor
authored
28 has $.disk;
a47664c @masak [crypt.pl] can remove disks
authored
29 has $.source;
30 }
31
89ce144 @masak [crypt.pl] adding a disk
authored
32 class Hanoi::DiskAdded does Event {
0f569fa @masak [crypt.pl] size -> disk refactor
authored
33 has $.disk;
89ce144 @masak [crypt.pl] adding a disk
authored
34 has $.target;
35 }
36
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
37 class X::Hanoi is Exception {
38 }
39
40 class X::Hanoi::LargerOnSmaller is X::Hanoi {
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
41 has $.larger;
42 has $.smaller;
43
44 method message($_:) {
45 "Cannot put the {.larger} on the {.smaller}"
46 }
47 }
48
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
49 class X::Hanoi::NoSuchRod is X::Hanoi {
4b7c1d2 @masak [crypt.pl] can't use rod names which don't exist
authored
50 has $.rod;
51 has $.name;
52
53 method message($_:) {
54 "No such {.rod} rod '{.name}'"
55 }
56 }
57
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
58 class X::Hanoi::RodHasNoDisks is X::Hanoi {
efa9ba6 @masak [crypt.pl] cannot move from a rod with no disks
authored
59 has $.name;
60
61 method message($_:) {
62 "Cannot move from the {.name} rod because there is no disk there"
63 }
64 }
65
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
66 class X::Hanoi::CoveredDisk is X::Hanoi {
0a4ebe5 @masak [crypt.pl] error when trying to move covered disk
authored
67 has $.disk;
68 has @.covered_by;
69
70 method message($_:) {
71 sub last_and(@things) {
72 map { "{'and ' if $_ == @things.end}@things[$_]" }, ^@things
73 }
8de2ebb @masak [crypt.pl] fixed CoveredDisk exception message
authored
74 my $disklist = @.covered_by > 1
75 ?? join ', ', last_and map { "the $_" }, @.covered_by
76 !! "the @.covered_by[0]";
0a4ebe5 @masak [crypt.pl] error when trying to move covered disk
authored
77 "Cannot move the {.disk}: it is covered by $disklist"
78 }
79 }
80
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
81 class X::Hanoi::ForbiddenDiskRemoval is X::Hanoi {
94cf486 @masak [crypt.pl] removing other disks is forbidden
authored
82 has $.disk;
83
84 method message($_:) {
85 "Removing the {.disk} is forbidden"
86 }
87 }
88
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
89 class X::Hanoi::DiskHasBeenRemoved is X::Hanoi {
50e0179 @masak [crypt.pl] cannot remove an already removed disk
authored
90 has $.disk;
91 has $.action;
92
93 method message($_:) {
94 "Cannot {.action} the {.disk} because it has been removed"
95 }
96 }
97
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
98 class X::Hanoi::NoSuchDisk is X::Hanoi {
41501d6 @masak [crypt.pl] cannot add a disk with a made-up name
authored
99 has $.disk;
100
101 method message($_:) {
102 "Cannot add a {.disk} because there is no such disk"
103 }
104 }
105
1f2e689 @masak [crypt.pl] introduce X::Hanoi type
authored
106 class X::Hanoi::DiskAlreadyOnARod is X::Hanoi {
4d11a9d @masak [crypt.pl] cannot add a disk that's already there
authored
107 has $.disk;
108
109 method message($_:) {
110 "Cannot add the {.disk} because it is already on a rod"
111 }
112 }
113
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
114 class Hanoi::Game {
d778fe8 @masak [crypt.pl] replaced a &map with a X~
authored
115 my @disks = <tiny small medium large huge> X~ ' disk';
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
116 my %size_of = @disks Z 1..5;
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
117
118 has %!state =
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
119 left => [reverse @disks],
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
120 middle => [],
121 right => [],
122 ;
123
6aa70d4 @masak [crypt.pl] post-unlocking achievement logic
authored
124 has $!achievement = 'locked';
125
e2a3e5d @masak [crypt.pl] allow move syntax specifying disks
authored
126 method move($source is copy, $target) {
127 if $source eq any @disks {
00629f1 @masak [crypt.pl] refactor; extract private method
authored
128 $source = self!rod_with_disk($source, 'move');
e2a3e5d @masak [crypt.pl] allow move syntax specifying disks
authored
129 }
00629f1 @masak [crypt.pl] refactor; extract private method
authored
130 die X::Hanoi::NoSuchRod.new(:rod<source>, :name($source))
131 unless %!state.exists($source);
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
132 die X::Hanoi::NoSuchRod.new(:rod<target>, :name($target))
133 unless %!state.exists($target);
00629f1 @masak [crypt.pl] refactor; extract private method
authored
134 my @source_rod := %!state{$source};
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
135 die X::Hanoi::RodHasNoDisks.new(:name($source))
136 unless @source_rod;
137 my @target_rod := %!state{$target};
138 my $moved_disk = @source_rod[*-1];
139 if @target_rod {
140 my $covered_disk = @target_rod[*-1];
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
141 if %size_of{$moved_disk} > %size_of{$covered_disk} {
142 die X::Hanoi::LargerOnSmaller.new(
143 :larger($moved_disk),
144 :smaller($covered_disk)
145 );
146 }
147 }
0f569fa @masak [crypt.pl] size -> disk refactor
authored
148 my @events
149 = Hanoi::DiskMoved.new(:disk($moved_disk), :$source, :$target);
caea86f @masak [crypt.pl] refactor - private apply method
authored
150 if %!state<right> == @disks-1
151 && $target eq 'right'
152 && $!achievement eq 'locked' {
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
153 @events.push(Hanoi::AchievementUnlocked.new);
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
154 }
0f569fa @masak [crypt.pl] size -> disk refactor
authored
155 if $moved_disk eq 'small disk' && $!achievement eq 'unlocked' {
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
156 @events.push(Hanoi::AchievementLocked.new);
96d9cf3 @masak [crypt.pl] achievements can be locked, too
authored
157 }
caea86f @masak [crypt.pl] refactor - private apply method
authored
158 self!apply($_) for @events;
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
159 return @events;
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
160 }
caea86f @masak [crypt.pl] refactor - private apply method
authored
161
a47664c @masak [crypt.pl] can remove disks
authored
162 method remove($disk) {
00629f1 @masak [crypt.pl] refactor; extract private method
authored
163 my $source = self!rod_with_disk($disk, 'remove');
164 die X::Hanoi::ForbiddenDiskRemoval.new(:$disk)
0f569fa @masak [crypt.pl] size -> disk refactor
authored
165 unless $disk eq 'tiny disk';
166 my @events = Hanoi::DiskRemoved.new(:$disk, :$source);
00629f1 @masak [crypt.pl] refactor; extract private method
authored
167 self!apply($_) for @events;
168 return @events;
169 }
170
89ce144 @masak [crypt.pl] adding a disk
authored
171 method add($disk, $target) {
41501d6 @masak [crypt.pl] cannot add a disk with a made-up name
authored
172 die X::Hanoi::NoSuchDisk.new(:$disk)
173 unless $disk eq any(@disks);
2fecc91 @masak [crypt.pl] refuse to add to a nonexistent rod
authored
174 die X::Hanoi::NoSuchRod.new(:rod<target>, :name($target))
175 unless %!state.exists($target);
4d11a9d @masak [crypt.pl] cannot add a disk that's already there
authored
176 die X::Hanoi::DiskAlreadyOnARod.new(:$disk)
177 if grep { $disk eq any(@$_) }, %!state.values;
0f569fa @masak [crypt.pl] size -> disk refactor
authored
178 my @events = Hanoi::DiskAdded.new(:$disk, :$target);
89ce144 @masak [crypt.pl] adding a disk
authored
179 self!apply($_) for @events;
180 return @events;
181 }
182
00629f1 @masak [crypt.pl] refactor; extract private method
authored
183 # The method will throw X::Hanoi::CoveredDisk if the disk is not topmost,
184 # or X::Hanoi::DiskHasBeenRemoved if the disk isn't found on any rod.
185 method !rod_with_disk($disk, $action) {
186 for %!state -> (:key($rod), :value(@disks)) {
a47664c @masak [crypt.pl] can remove disks
authored
187 if $disk eq any(@disks) {
b6edc9c @masak [crypt.pl] cannot remove covered disks
authored
188 sub smaller_disks {
189 grep { %size_of{$_} < %size_of{$disk} }, @disks;
190 }
191 die X::Hanoi::CoveredDisk.new(:$disk, :covered_by(smaller_disks))
192 unless @disks[*-1] eq $disk;
00629f1 @masak [crypt.pl] refactor; extract private method
authored
193 return $rod;
a47664c @masak [crypt.pl] can remove disks
authored
194 }
195 }
00629f1 @masak [crypt.pl] refactor; extract private method
authored
196 die X::Hanoi::DiskHasBeenRemoved.new(:$disk, :$action);
a47664c @masak [crypt.pl] can remove disks
authored
197 }
198
caea86f @masak [crypt.pl] refactor - private apply method
authored
199 # RAKUDO: private multimethods NYI
200 method !apply(Event $_) {
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
201 when Hanoi::DiskMoved {
caea86f @masak [crypt.pl] refactor - private apply method
authored
202 my @source_rod := %!state{.source};
203 my @target_rod := %!state{.target};
204 @target_rod.push( @source_rod.pop );
205 }
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
206 when Hanoi::AchievementUnlocked {
caea86f @masak [crypt.pl] refactor - private apply method
authored
207 $!achievement = 'unlocked';
208 }
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
209 when Hanoi::AchievementLocked {
caea86f @masak [crypt.pl] refactor - private apply method
authored
210 $!achievement = 'locked';
211 }
a47664c @masak [crypt.pl] can remove disks
authored
212 when Hanoi::DiskRemoved {
213 my @source_rod := %!state{.source};
214 @source_rod.pop;
215 }
4d11a9d @masak [crypt.pl] cannot add a disk that's already there
authored
216 when Hanoi::DiskAdded {
217 my @target_rod := %!state{.target};
0f569fa @masak [crypt.pl] size -> disk refactor
authored
218 @target_rod.push(.disk);
4d11a9d @masak [crypt.pl] cannot add a disk that's already there
authored
219 }
caea86f @masak [crypt.pl] refactor - private apply method
authored
220 }
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
221 }
222
66e182d @masak [crypt.pl] test function refactor
authored
223 sub throws_exception(&code, $ex_type, $message, &followup?) {
b0affd2 @masak [crypt.pl] larger disk on smaller not allowed
authored
224 &code();
225 ok 0, $message;
226 if &followup {
227 diag 'Not running followup because an exception was not triggered';
228 }
229 CATCH {
230 default {
231 ok 1, $message;
232 my $type_ok = $_.WHAT === $ex_type;
233 ok $type_ok , "right exception type ({$ex_type.^name})";
234 if $type_ok {
235 &followup($_);
236 } else {
237 diag "Got: {$_.WHAT.gist}\n"
238 ~"Expected: {$ex_type.gist}";
239 diag "Exception message: $_.message()";
240 diag 'Not running followup because type check failed';
241 }
242 }
35435dc @masak [crypt.pl] hanoi game, legal move
authored
243 }
244 }
245
72ef665 @masak [bin/crypt] implement hanoi CLI client
authored
246 multi MAIN('hanoi') {
247 my Hanoi::Game $game .= new;
248 my @disks = <tiny small medium large huge> X~ ' disk';
249 my @rods = <left middle right>;
250
251 sub params($method) {
252 $method.signature.params
253 ==> grep { .positional && !.invocant }
254 ==> map { .name.substr(1) }
255 }
256 my %commands = map { $^m.name => params($m) }, $game.^methods;
257 my @all_events;
258
259 sub print_board() {
260 my %s =
261 left => [reverse @disks],
262 middle => [],
263 right => [],
264 ;
265 for @all_events {
266 when Hanoi::DiskMoved { %s{.target}.push: %s{.source}.pop }
267 when Hanoi::DiskRemoved { %s{.source}.pop }
268 when Hanoi::DiskAdded { %s{.target}.push: .disk }
269 }
270
271 say "";
272 for reverse ^6 -> $line {
273 my %disks =
274 'none' => ' | ',
275 'tiny disk' => ' = ',
276 'small disk' => ' === ',
277 'medium disk' => ' ===== ',
278 'large disk' => ' ======= ',
279 'huge disk' => ' ========= ',
280 ;
281
282 sub disk($rod) {
283 my $disk = %s{$rod}[$line] // 'none';
284 %disks{ $disk };
285 }
286
287 say join ' ', map &disk, @rods;
288 }
289 say join '--', '-----------' xx @rods;
290 say "";
291 }
292
293 print_board();
294 loop {
295 my $command = prompt('> ');
296 unless defined $command {
297 say "";
298 last;
299 }
300 given lc $command {
301 when 'q' | 'quit' { last }
302 when 'h' | 'help' {
303 say "Available commands:";
304 for %commands.sort {
305 say " {.key} {map { "<$_>" }, .value.list}";
306 }
307 say "";
308 say "Disks: ", join ', ', @disks;
309 say "Rods: ", join ', ', @rods;
310 }
b882552 @masak [bin/crypt] implement 'show' command
authored
311 when 's' | 'show' { print_board() }
72ef665 @masak [bin/crypt] implement hanoi CLI client
authored
312
313 sub munge { $^s.subst(/' disk'»/, '_disk', :g) }
314 sub unmunge { $^s.subst(/'_disk'»/, ' disk', :g) }
7d8ed24 @masak [bin/crypt] no need to modify $command in-place
authored
315 my $verb = .&munge.words[0].&unmunge;
316 my @args = .&munge.words[1..*]».&unmunge;
72ef665 @masak [bin/crypt] implement hanoi CLI client
authored
317 when %commands.exists($verb) {
318 my @req_args = %commands{$verb}.list;
319 when @args != @req_args {
320 say "You passed in {+@args} arguments, but $verb requires {+@req_args}.";
321 say "The arguments are {map { "<$_>" }, @req_args}.";
322 say "'help' for more help.";
323 }
324 my @events = $game."$verb"(|@args);
325 push @all_events, @events;
326 print_board();
327 CATCH {
328 when X::Hanoi { say .message }
329 }
330 }
331
332 default {
333 say "Sorry, the game doesn't recognize that command. :/";
334 say "'help' if you're confused as well.";
335 }
336 }
337 say "";
338 }
339 }
340
35435dc @masak [crypt.pl] hanoi game, legal move
authored
341 multi MAIN('test', 'hanoi') {
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
342 {
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
343 my $game = Hanoi::Game.new();
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
344
345 is $game.move('left', 'middle'),
0f569fa @masak [crypt.pl] size -> disk refactor
authored
346 Hanoi::DiskMoved.new(
347 :disk('tiny disk'),
348 :source<left>,
349 :target<middle>
350 ),
c9e01dd @masak [crypt.pl] cannot move a disk that has been removed
authored
351 'moving a disk (+)';
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
352
353 throws_exception
354 { $game.move('left', 'middle') },
355 X::Hanoi::LargerOnSmaller,
c9e01dd @masak [crypt.pl] cannot move a disk that has been removed
authored
356 'moving a disk (-) larger disk on smaller',
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
357 {
358 is .larger, 'small disk', '.larger attribute';
359 is .smaller, 'tiny disk', '.smaller attribute';
360 is .message,
361 'Cannot put the small disk on the tiny disk',
362 '.message attribute';
363 };
364
365 throws_exception
366 { $game.move('gargle', 'middle') },
367 X::Hanoi::NoSuchRod,
c9e01dd @masak [crypt.pl] cannot move a disk that has been removed
authored
368 'moving a disk (-) no such source rod',
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
369 {
370 is .rod, 'source', '.rod attribute';
371 is .name, 'gargle', '.name attribute';
372 is .message,
373 q[No such source rod 'gargle'],
374 '.message attribute';
375 };
376
377 throws_exception
378 { $game.move('middle', 'clown') },
379 X::Hanoi::NoSuchRod,
c9e01dd @masak [crypt.pl] cannot move a disk that has been removed
authored
380 'moving a disk (-) no such target rod',
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
381 {
382 is .rod, 'target', '.rod attribute';
383 is .name, 'clown', '.name attribute';
384 is .message,
385 q[No such target rod 'clown'],
386 '.message attribute';
387 };
388
389 throws_exception
390 { $game.move('right', 'middle') },
391 X::Hanoi::RodHasNoDisks,
c9e01dd @masak [crypt.pl] cannot move a disk that has been removed
authored
392 'moving a disk (-) rod has no disks',
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
393 {
394 is .name, 'right', '.name attribute';
395 is .message,
396 q[Cannot move from the right rod because there is no disk there],
397 '.message attribute';
398 };
399 }
35435dc @masak [crypt.pl] hanoi game, legal move
authored
400
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
401 {
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
402 my $game = Hanoi::Game.new();
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
403
404 multi hanoi_moves($source, $, $target, 1) {
405 # A single disk, easy; just move it directly.
406 $source, 'to', $target
407 }
408 multi hanoi_moves($source, $helper, $target, $n) {
409 # $n-1 disks on to; move them off to the $helper rod first...
410 hanoi_moves($source, $target, $helper, $n-1),
411 # ...then move over the freed disk at the bottom...
412 hanoi_moves($source, $helper, $target, 1),
413 # ...and finally move the rest from $helper to $target.
414 hanoi_moves($helper, $source, $target, $n-1)
415 }
416
417 # Let's play out the thing to the end. 32 moves.
418 my @moves = hanoi_moves("left", "middle", "right", 5);
419 # RAKUDO: .splice doesn't do WhateverCode yet: wanted *-3
420 my @last_move = @moves.splice(@moves.end-2);
421
422 lives_ok {
423 for @moves -> $source, $, $target {
424 my ($event, @rest) = $game.move($source, $target);
425 die "Unexpected event type: {$event.name}"
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
426 unless $event ~~ Hanoi::DiskMoved;
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
427 die "Unexpected extra events: @rest"
428 if @rest;
429 }
430 }, 'making all the moves to the end of the game works';
35435dc @masak [crypt.pl] hanoi game, legal move
authored
431
efa9ba6 @masak [crypt.pl] cannot move from a rod with no disks
authored
432 {
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
433 my ($source, $, $target) = @last_move;
434 is $game.move($source, $target), (
0f569fa @masak [crypt.pl] size -> disk refactor
authored
435 Hanoi::DiskMoved.new(:disk('tiny disk'), :$source, :$target),
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
436 Hanoi::AchievementUnlocked.new(),
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
437 ), 'putting all disks on the right rod unlocks achievement';
6aa70d4 @masak [crypt.pl] post-unlocking achievement logic
authored
438
439 $game.move($target, $source);
440 is $game.move($source, $target), (
0f569fa @masak [crypt.pl] size -> disk refactor
authored
441 Hanoi::DiskMoved.new(:disk('tiny disk'), :$source, :$target),
6aa70d4 @masak [crypt.pl] post-unlocking achievement logic
authored
442 ), 'moving things back and forth does not unlock achievement again';
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
443 }
96d9cf3 @masak [crypt.pl] achievements can be locked, too
authored
444
445 {
446 $game.move('right', 'middle');
447 is $game.move(my $source = 'right', my $target = 'left'), (
0f569fa @masak [crypt.pl] size -> disk refactor
authored
448 Hanoi::DiskMoved.new(:disk('small disk'), :$source, :$target),
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
449 Hanoi::AchievementLocked.new(),
96d9cf3 @masak [crypt.pl] achievements can be locked, too
authored
450 ), 'removing two disks from the right rod locks achievement';
451 }
b9caade @masak [crypt.pl] all disks on the right rod => win
authored
452 }
efa9ba6 @masak [crypt.pl] cannot move from a rod with no disks
authored
453
e2a3e5d @masak [crypt.pl] allow move syntax specifying disks
authored
454 {
df311c2 @masak [crypt.pl] name refactor: Hanoi::
authored
455 my $game = Hanoi::Game.new();
e2a3e5d @masak [crypt.pl] allow move syntax specifying disks
authored
456
457 is $game.move('tiny disk', my $target = 'middle'),
0f569fa @masak [crypt.pl] size -> disk refactor
authored
458 Hanoi::DiskMoved.new(:disk('tiny disk'), :source<left>, :$target),
e2a3e5d @masak [crypt.pl] allow move syntax specifying disks
authored
459 'naming source disk instead of the rod (+)';
460 }
461
0a4ebe5 @masak [crypt.pl] error when trying to move covered disk
authored
462 {
463 my $game = Hanoi::Game.new();
464
465 throws_exception
466 { $game.move('large disk', 'right') },
467 X::Hanoi::CoveredDisk,
468 'naming source disk instead of the rod (-)',
469 {
470 is .disk, 'large disk', '.disk attribute';
471 is .covered_by, ['medium disk', 'small disk', 'tiny disk'],
472 '.covered_by attribute';
473 is .message,
474 'Cannot move the large disk: it is covered by '
475 ~ 'the medium disk, the small disk, and the tiny disk',
476 '.message attribute';
477 };
478 }
479
a47664c @masak [crypt.pl] can remove disks
authored
480 {
481 my $game = Hanoi::Game.new();
482
8de2ebb @masak [crypt.pl] fixed CoveredDisk exception message
authored
483 throws_exception
484 { $game.move('small disk', 'right') },
485 X::Hanoi::CoveredDisk,
486 'naming source disk instead of the rod (-) no and for one-item lists',
487 {
488 is .message,
489 'Cannot move the small disk: it is covered by the tiny disk',
490 '.message attribute';
491 };
492 }
493
494 {
495 my $game = Hanoi::Game.new();
496
a47664c @masak [crypt.pl] can remove disks
authored
497 is $game.remove('tiny disk'),
0f569fa @masak [crypt.pl] size -> disk refactor
authored
498 Hanoi::DiskRemoved.new(:disk('tiny disk'), :source<left>),
a47664c @masak [crypt.pl] can remove disks
authored
499 'removing a disk (+)';
94cf486 @masak [crypt.pl] removing other disks is forbidden
authored
500
501 throws_exception
502 { $game.remove('small disk') },
503 X::Hanoi::ForbiddenDiskRemoval,
504 'removing a disk (-) removing disk is forbidden',
505 {
506 is .disk, 'small disk', '.disk attribute';
507 is .message,
508 'Removing the small disk is forbidden',
509 '.message attribute';
510 };
b6edc9c @masak [crypt.pl] cannot remove covered disks
authored
511
512 throws_exception
513 { $game.remove('medium disk') },
514 X::Hanoi::CoveredDisk,
515 'removing a disk (-) the disk is covered',
516 {
517 is .disk, 'medium disk', '.disk attribute';
518 is .covered_by, ['small disk'],
519 '.covered_by attribute';
520 };
26f2c6b @masak [crypt.pl] uncovered, removal of a disk still forbidden
authored
521
522 $game.move('small disk', 'middle');
523 throws_exception
524 { $game.remove('medium disk') },
525 X::Hanoi::ForbiddenDiskRemoval,
526 'removing a disk (-) uncovered, removal is still forbidden',
527 {
528 is .disk, 'medium disk', '.disk attribute';
529 };
a47664c @masak [crypt.pl] can remove disks
authored
530 }
531
50e0179 @masak [crypt.pl] cannot remove an already removed disk
authored
532 {
533 my $game = Hanoi::Game.new();
534
535 $game.remove('tiny disk');
536
537 throws_exception
538 { $game.remove('tiny disk') },
539 X::Hanoi::DiskHasBeenRemoved,
540 'removing a disk (-) the disk had already been removed',
541 {
542 is .disk, 'tiny disk', '.disk attribute';
543 is .action, 'remove', '.action attribute';
544 is .message,
545 'Cannot remove the tiny disk because it has been removed',
546 '.message attribute';
547 };
c9e01dd @masak [crypt.pl] cannot move a disk that has been removed
authored
548
549 throws_exception
550 { $game.move('tiny disk', 'middle') },
551 X::Hanoi::DiskHasBeenRemoved,
552 'moving a disk (-) the disk had already been removed',
553 {
554 is .disk, 'tiny disk', '.disk attribute';
555 is .action, 'move', '.action attribute';
556 is .message,
557 'Cannot move the tiny disk because it has been removed',
558 '.message attribute';
559 };
89ce144 @masak [crypt.pl] adding a disk
authored
560
2fecc91 @masak [crypt.pl] refuse to add to a nonexistent rod
authored
561 throws_exception
562 { $game.add('tiny disk', 'pineapple') },
563 X::Hanoi::NoSuchRod,
564 'moving a disk (-) the rod does not exist',
565 {
566 is .rod, 'target', '.rod attribute';
567 is .name, 'pineapple', '.name attribute';
568 };
569
89ce144 @masak [crypt.pl] adding a disk
authored
570 is $game.add('tiny disk', 'left'),
0f569fa @masak [crypt.pl] size -> disk refactor
authored
571 Hanoi::DiskAdded.new(:disk('tiny disk'), :target<left>),
89ce144 @masak [crypt.pl] adding a disk
authored
572 'adding a disk (+)';
41501d6 @masak [crypt.pl] cannot add a disk with a made-up name
authored
573
574 throws_exception
575 { $game.add('humongous disk', 'middle') },
576 X::Hanoi::NoSuchDisk,
577 'adding a disk (-) there is no such disk',
578 {
579 is .disk, 'humongous disk', '.disk attribute';
580 is .message,
581 'Cannot add a humongous disk because there is no such disk',
582 '.message attribute';
583 };
4d11a9d @masak [crypt.pl] cannot add a disk that's already there
authored
584
585 throws_exception
586 { $game.add('tiny disk', 'right') },
587 X::Hanoi::DiskAlreadyOnARod,
588 'adding a disk (-) the disk is already on a rod',
589 {
590 is .disk, 'tiny disk', '.disk attribute';
591 is .message,
592 'Cannot add the tiny disk because it is already on a rod',
593 '.message attribute';
594 };
50e0179 @masak [crypt.pl] cannot remove an already removed disk
authored
595 }
596
35435dc @masak [crypt.pl] hanoi game, legal move
authored
597 done;
598 }
Something went wrong with that request. Please try again.