Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

[crypt.pl] larger disk on smaller not allowed

  • Loading branch information...
commit b0affd256cd439fefa0810ecdf8f3f474339d172 1 parent 35435dc
Carl Mäsak authored July 01, 2012

Showing 1 changed file with 68 additions and 1 deletion. Show diff stats Hide diff stats

  1. 69  crypt.pl
69  crypt.pl
@@ -16,9 +16,65 @@
16 16
     has $.to;
17 17
 }
18 18
 
  19
+class X::Hanoi::LargerOnSmaller is Exception {
  20
+    has $.larger;
  21
+    has $.smaller;
  22
+
  23
+    method message($_:) {
  24
+        "Cannot put the {.larger} on the {.smaller}"
  25
+    }
  26
+}
  27
+
19 28
 class HanoiGame {
  29
+    my @names = map { "$_ disk" }, <tiny small medium big huge>;
  30
+    my %size_of = @names Z 1..5;
  31
+
  32
+    has %!state =
  33
+        left   => [reverse @names],
  34
+        middle => [],
  35
+        right  => [],
  36
+    ;
  37
+
20 38
     method move($from, $to) {
21  
-        DiskMoved.new(:size<tiny>, :$from, :$to);
  39
+        my @from_rod := %!state{$from};
  40
+        my @to_rod   := %!state{$to};
  41
+        my $moved_disk = @from_rod[*-1];
  42
+        if @to_rod {
  43
+            my $covered_disk = @to_rod[*-1];
  44
+            if %size_of{$moved_disk} > %size_of{$covered_disk} {
  45
+                die X::Hanoi::LargerOnSmaller.new(
  46
+                    :larger($moved_disk),
  47
+                    :smaller($covered_disk)
  48
+                );
  49
+            }
  50
+        }
  51
+        @to_rod.push( @from_rod.pop );
  52
+        my $size = $moved_disk.words[0];
  53
+        DiskMoved.new(:$size, :$from, :$to);
  54
+    }
  55
+}
  56
+
  57
+sub throws_exception(&code, $ex_type, &followup?) {
  58
+    my $message = 'code dies as expected';
  59
+    &code();
  60
+    ok 0, $message;
  61
+    if &followup {
  62
+        diag 'Not running followup because an exception was not triggered';
  63
+    }
  64
+    CATCH {
  65
+        default {
  66
+            ok 1, $message;
  67
+            my $type_ok = $_.WHAT === $ex_type;
  68
+            ok $type_ok , "right exception type ({$ex_type.^name})";
  69
+            if $type_ok {
  70
+                &followup($_);
  71
+            } else {
  72
+                diag "Got:      {$_.WHAT.gist}\n"
  73
+                    ~"Expected: {$ex_type.gist}";
  74
+                diag "Exception message: $_.message()";
  75
+                diag 'Not running followup because type check failed';
  76
+            }
  77
+        }
22 78
     }
23 79
 }
24 80
 
@@ -29,5 +85,16 @@
29 85
        DiskMoved.new(:size<tiny>, :from<left>, :to<middle>),
30 86
        'legal move (+)';
31 87
 
  88
+    throws_exception
  89
+        { $game.move('left', 'middle') },
  90
+        X::Hanoi::LargerOnSmaller,
  91
+        {
  92
+            is .larger, 'small disk', '.larger attribute';
  93
+            is .smaller, 'tiny disk', '.smaller attribute';
  94
+            is .message,
  95
+               'Cannot put the small disk on the tiny disk',
  96
+               '.message attribute';
  97
+        };
  98
+
32 99
     done;
33 100
 }

0 notes on commit b0affd2

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