Skip to content
Browse files

[crypt.pl] error when trying to move covered disk

If you move('large', 'right') but the large disk is under a
bunch of other disks, you get an error.
  • Loading branch information...
1 parent df311c2 commit 0a4ebe5e85fce69674381dd2fe189b97d3a6871c @masak committed Jul 1, 2012
Showing with 39 additions and 2 deletions.
  1. +39 −2 crypt.pl
View
41 crypt.pl
@@ -48,8 +48,21 @@
}
}
+class X::Hanoi::CoveredDisk is Exception {
+ has $.disk;
+ has @.covered_by;
+
+ method message($_:) {
+ sub last_and(@things) {
+ map { "{'and ' if $_ == @things.end}@things[$_]" }, ^@things
+ }
+ my $disklist = join ', ', last_and map { "the $_" }, @.covered_by;
+ "Cannot move the {.disk}: it is covered by $disklist"
+ }
+}
+
class Hanoi::Game {
- my @disks = map { "$_ disk" }, <tiny small medium big huge>;
+ my @disks = map { "$_ disk" }, <tiny small medium large huge>;
my %size_of = @disks Z 1..5;
has %!state =
@@ -63,8 +76,14 @@
method move($source is copy, $target) {
my @source_rod;
if $source eq any @disks {
+ my $disk = $source;
for %!state -> ( :key($rod), :value(@disks) ) {
- if $source eq any(@disks) {
+ if $disk eq any(@disks) {
+ sub smaller_disks {
+ grep { %size_of{$_} < %size_of{$disk} }, @disks;
+ }
+ die X::Hanoi::CoveredDisk.new(:$disk, :covered_by(smaller_disks))
+ unless @disks[*-1] eq $disk;
@source_rod := @disks;
$source = $rod;
last;
@@ -261,5 +280,23 @@ (&code, $ex_type, $message, &followup?)
'naming source disk instead of the rod (+)';
}
+ {
+ my $game = Hanoi::Game.new();
+
+ throws_exception
+ { $game.move('large disk', 'right') },
+ X::Hanoi::CoveredDisk,
+ 'naming source disk instead of the rod (-)',
+ {
+ is .disk, 'large disk', '.disk attribute';
+ is .covered_by, ['medium disk', 'small disk', 'tiny disk'],
+ '.covered_by attribute';
+ is .message,
+ 'Cannot move the large disk: it is covered by '
+ ~ 'the medium disk, the small disk, and the tiny disk',
+ '.message attribute';
+ };
+ }
+
done;
}

0 comments on commit 0a4ebe5

Please sign in to comment.
Something went wrong with that request. Please try again.