Merge branch 'world-rethrow' into nom

rakudo · May 25, 2012 · ecf355f · ecf355f
2 parents 5274a37 + 6d6e154
commit ecf355f
Show file tree

Hide file tree

Showing 2 changed files with 54 additions and 1 deletion.
diff --git a/src/Perl6/World.pm b/src/Perl6/World.pm
@@ -1152,7 +1152,10 @@ class Perl6::World is HLL::World {
 
     # Adds a method to the meta-object.
     method pkg_add_method($/, $obj, $meta_method_name, $name, $code_object) {
-        $obj.HOW."$meta_method_name"($obj, $name, $code_object);
+        self.ex-handle($/, {
+                $obj.HOW."$meta_method_name"($obj, $name, $code_object)
+            }
+        )
     }
 
     # Handles setting the body block code for a role.
@@ -1917,4 +1920,35 @@ class Perl6::World is HLL::World {
             $/.CURSOR.panic(nqp::join('', @err));
         }
     }
+
+    method ex-handle($/, $code) {
+        my $res;
+        my $ex;
+        my $nok;
+        try {
+            $res := $code();
+            CATCH {
+                $nok := 1;
+                $ex  := $_;
+            }
+        }
+        if $nok {
+            $*W.rethrow($/, $ex);
+        } else {
+            $res;
+        }
+    }
+
+    method rethrow($/, $err) {
+        my $ex_t    := self.find_symbol(['X', 'Comp', 'AdHoc']);
+        my $coercer := self.find_symbol(['&COMP_EXCEPTION']);
+        my $p6ex    := $coercer($err);
+        nqp::bindattr($p6ex, $ex_t, '$!filename',
+            nqp::box_s(pir::find_caller_lex__ps('$?FILES'),
+                self.find_symbol(['Str'])));
+        nqp::bindattr($p6ex, $ex_t, '$!line',
+            nqp::box_i(HLL::Compiler.lineof($/.orig, $/.from),
+                self.find_symbol(['Int'])));
+        $p6ex.rethrow();
+    }
 }
diff --git a/src/core/Exception.pm b/src/core/Exception.pm
@@ -28,6 +28,7 @@ my class Exception {
         pir::throw__0P($!ex)
     }
     method rethrow() is hidden_from_backtrace {
+        pir::setattribute__vPsP($!ex, 'payload', nqp::p6decont(self));
         pir::rethrow__0P($!ex)
     }
 }
@@ -73,6 +74,21 @@ sub EXCEPTION(|$) {
     }
 }
 
+my class X::Comp::AdHoc { ... }
+sub COMP_EXCEPTION(|$) {
+    my Mu $parrot_ex := nqp::shift(pir::perl6_current_args_rpa__P());
+    my Mu $payload   := nqp::atkey($parrot_ex, 'payload');
+    if nqp::p6bool(pir::type_check__IPP($payload, Exception)) {
+        nqp::bindattr($payload, Exception, '$!ex', $parrot_ex);
+        $payload;
+    } else {
+        my $ex := nqp::create(X::Comp::AdHoc);
+        nqp::bindattr($ex, Exception, '$!ex', $parrot_ex);
+        nqp::bindattr($ex, X::AdHoc, '$!payload', nqp::p6box_s(nqp::atkey($parrot_ex, 'message')));
+        $ex;
+    }
+}
+
 
 do {
     sub is_runtime($bt) {
@@ -254,6 +270,9 @@ my role X::Comp is Exception {
     }
 }
 
+# XXX a hack for getting line numbers from exceptions from the metamodel
+my class X::Comp::AdHoc is X::AdHoc does X::Comp { }
+
 my role X::Syntax does X::Comp { }
 my role X::Pod                 { }