Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Merge branch 'world-rethrow' into nom

  • Loading branch information...
commit ecf355fa54492999de368a4ca1aed21a016470ec 2 parents 5274a37 + 6d6e154
Moritz Lenz authored May 25, 2012
36  src/Perl6/World.pm
@@ -1152,7 +1152,10 @@ class Perl6::World is HLL::World {
1152 1152
     
1153 1153
     # Adds a method to the meta-object.
1154 1154
     method pkg_add_method($/, $obj, $meta_method_name, $name, $code_object) {
1155  
-        $obj.HOW."$meta_method_name"($obj, $name, $code_object);
  1155
+        self.ex-handle($/, {
  1156
+                $obj.HOW."$meta_method_name"($obj, $name, $code_object)
  1157
+            }
  1158
+        )
1156 1159
     }
1157 1160
     
1158 1161
     # Handles setting the body block code for a role.
@@ -1917,4 +1920,35 @@ class Perl6::World is HLL::World {
1917 1920
             $/.CURSOR.panic(nqp::join('', @err));
1918 1921
         }
1919 1922
     }
  1923
+
  1924
+    method ex-handle($/, $code) {
  1925
+        my $res;
  1926
+        my $ex;
  1927
+        my $nok;
  1928
+        try {
  1929
+            $res := $code();
  1930
+            CATCH {
  1931
+                $nok := 1;
  1932
+                $ex  := $_;
  1933
+            }
  1934
+        }
  1935
+        if $nok {
  1936
+            $*W.rethrow($/, $ex);
  1937
+        } else {
  1938
+            $res;
  1939
+        }
  1940
+    }
  1941
+
  1942
+    method rethrow($/, $err) {
  1943
+        my $ex_t    := self.find_symbol(['X', 'Comp', 'AdHoc']);
  1944
+        my $coercer := self.find_symbol(['&COMP_EXCEPTION']);
  1945
+        my $p6ex    := $coercer($err);
  1946
+        nqp::bindattr($p6ex, $ex_t, '$!filename',
  1947
+            nqp::box_s(pir::find_caller_lex__ps('$?FILES'),
  1948
+                self.find_symbol(['Str'])));
  1949
+        nqp::bindattr($p6ex, $ex_t, '$!line',
  1950
+            nqp::box_i(HLL::Compiler.lineof($/.orig, $/.from),
  1951
+                self.find_symbol(['Int'])));
  1952
+        $p6ex.rethrow();
  1953
+    }
1920 1954
 }
19  src/core/Exception.pm
@@ -28,6 +28,7 @@ my class Exception {
28 28
         pir::throw__0P($!ex)
29 29
     }
30 30
     method rethrow() is hidden_from_backtrace {
  31
+        pir::setattribute__vPsP($!ex, 'payload', nqp::p6decont(self));
31 32
         pir::rethrow__0P($!ex)
32 33
     }
33 34
 }
@@ -73,6 +74,21 @@ sub EXCEPTION(|$) {
73 74
     }
74 75
 }
75 76
 
  77
+my class X::Comp::AdHoc { ... }
  78
+sub COMP_EXCEPTION(|$) {
  79
+    my Mu $parrot_ex := nqp::shift(pir::perl6_current_args_rpa__P());
  80
+    my Mu $payload   := nqp::atkey($parrot_ex, 'payload');
  81
+    if nqp::p6bool(pir::type_check__IPP($payload, Exception)) {
  82
+        nqp::bindattr($payload, Exception, '$!ex', $parrot_ex);
  83
+        $payload;
  84
+    } else {
  85
+        my $ex := nqp::create(X::Comp::AdHoc);
  86
+        nqp::bindattr($ex, Exception, '$!ex', $parrot_ex);
  87
+        nqp::bindattr($ex, X::AdHoc, '$!payload', nqp::p6box_s(nqp::atkey($parrot_ex, 'message')));
  88
+        $ex;
  89
+    }
  90
+}
  91
+
76 92
 
77 93
 do {
78 94
     sub is_runtime($bt) {
@@ -254,6 +270,9 @@ my role X::Comp is Exception {
254 270
     }
255 271
 }
256 272
 
  273
+# XXX a hack for getting line numbers from exceptions from the metamodel
  274
+my class X::Comp::AdHoc is X::AdHoc does X::Comp { }
  275
+
257 276
 my role X::Syntax does X::Comp { }
258 277
 my role X::Pod                 { }
259 278
 

0 notes on commit ecf355f

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