Typed exceptions from PRE/POST failures

jnthn++ for the help
rakudo · Mar 18, 2012 · d1505ae · d1505ae
1 parent 5264177
commit d1505ae
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 4 deletions.
diff --git a/src/Perl6/World.pm b/src/Perl6/World.pm
@@ -1254,14 +1254,26 @@ class Perl6::World is HLL::World {
                 PAST::Var.new( :name($sym), :scope('lexical_6model') ));
         }
         elsif $phaser eq 'PRE' || $phaser eq 'POST' {
+            my $what := self.add_string_constant(
+                $phaser eq 'PRE' ?? 'Precondition' !! 'Postcondition'
+            );
+            $what.named('what');
+            my $condition := self.add_string_constant(~$/<blorst>);
+            $condition.named('condition');
+
             $phaser_past[1] := PAST::Op.new(
                 :pasttype('unless'),
                 $phaser_past[1],
                 PAST::Op.new(
-                    :pasttype('call'), :name('&die'),
-                    self.add_string_constant($phaser eq 'PRE' ??
-                        'Precondition failed' !!
-                        'Postcondition failed')));
+                    :pasttype('callmethod'), :name('throw'),
+                    PAST::Op.new(
+                        :pasttype('callmethod'), :name('new'),
+                        self.get_ref(self.find_symbol(['X', 'Phaser', 'PrePost'])),
+                        $what,
+                        $condition,
+                    )
+                ),
+            );
             @!CODES[+@!CODES - 1].add_phaser($phaser, $block);
             return PAST::Var.new(:name('Nil'), :scope('lexical_6model'));
         }

diff --git a/src/core/Exception.pm b/src/core/Exception.pm
@@ -497,4 +497,14 @@ my class X::Package::Stubbed does X::Comp {
     }
 }
 
+my class X::Phaser::PrePost is Exception {
+    has $.what = 'Precondition';
+    has $.condition;
+    method message {
+        $.condition.defined
+            ?? "$.what '$.condition' failed"
+            !! "$.what failed";
+    }
+}
+
 # vim: ft=perl6