From cff7e74614bdf1d08bd82a58f65927464fba64b4 Mon Sep 17 00:00:00 2001
From: markmont <markmont@markmont-dev.web.itd.umich.edu>
Date: Sun, 25 Oct 2009 14:59:26 -0400
Subject: [PATCH] make $! always be a Perl object instead of sometimes being a
 Parrot Exception PMC.

---
 src/builtins/control.pir  |   16 ++++++++++++----
 src/classes/Exception.pir |    9 +++++++++
 src/parser/actions.pm     |   10 ++++++++--
 3 files changed, 29 insertions(+), 6 deletions(-)

diff --git a/src/builtins/control.pir b/src/builtins/control.pir
index 9b9f53e..f81f033 100644
--- a/src/builtins/control.pir
+++ b/src/builtins/control.pir
@@ -204,7 +204,10 @@ the moment -- we'll do more complex handling a bit later.)
 
 .sub 'die' :multi('Exception')
     .param pmc ex
-    set_global '$!', ex
+    .local pmc p6ex
+    p6ex = new ['Perl6Exception']
+    setattribute p6ex, '$!exception', ex
+    set_global '$!', p6ex
     throw ex
     .return ()
 .end
@@ -212,17 +215,20 @@ the moment -- we'll do more complex handling a bit later.)
 .sub 'die' :multi(_)
     .param pmc list            :slurpy
     .local string message
+    .local pmc p6ex
     .local pmc ex
 
     message = join '', list
     if message > '' goto have_message
     message = "Died\n"
   have_message:
+    p6ex = new ['Perl6Exception']
     ex = root_new ['parrot';'Exception']
     ex = message
     ex['severity'] = .EXCEPT_FATAL
     ex['type'] = .CONTROL_ERROR
-    set_global '$!', ex
+    setattribute p6ex, '$!exception', ex
+    set_global '$!', p6ex
     throw ex
     .return ()
 .end
@@ -360,7 +366,7 @@ on error.
     block_info.'namespace'($P0)
 
     .local pmc compiler, invokable
-    .local pmc res, exception
+    .local pmc res, exception, parrotex
     unless have_lang goto no_lang
     push_eh catch
     $S0 = lang
@@ -389,7 +395,9 @@ on error.
     goto done
 
   catch:
-    .get_results (exception)
+    .get_results (parrotex)
+    exception = new ['Perl6Exception']
+    setattribute exception, '$!exception', parrotex
 
   done:
     pop_eh
diff --git a/src/classes/Exception.pir b/src/classes/Exception.pir
index 92c057f..ba39c86 100644
--- a/src/classes/Exception.pir
+++ b/src/classes/Exception.pir
@@ -29,6 +29,15 @@
     .return ('undef')
 .end
 
+
+.sub '' :vtable('get_string') :method
+    .local pmc exception
+    exception = getattribute self, '$!exception'
+    $S0 = exception['message']
+    .return ($S0)
+.end
+
+
 # Local Variables:
 #   mode: pir
 #   fill-column: 100
diff --git a/src/parser/actions.pm b/src/parser/actions.pm
index e487cb3..080ea57 100644
--- a/src/parser/actions.pm
+++ b/src/parser/actions.pm
@@ -610,8 +610,14 @@ method statement_prefix($/) {
 
         ##  Add a catch node to the try op that captures the
         ##  exception object into $!.
-        my $catchpir := "    .get_results (%r)\n    store_lex '$!', %r";
-        $past.push( PAST::Op.new( :inline( $catchpir ) ) );
+        $past.push( PAST::Op.new(
+                        :inline( "    .get_results (%r)",
+                                 "    $P0 = new ['Perl6Exception']",
+                                 "    setattribute $P0, '$!exception', %r",
+                                 "    store_lex '$!', $P0"
+                        )
+                    )
+        );
 
         ##  Add an 'else' node to the try op that clears $! if
         ##  no exception occurred.
-- 
1.6.2.5

Index: S29-context/die.t
===================================================================
--- S29-context/die.t	(revision 28893)
+++ S29-context/die.t	(working copy)
@@ -12,9 +12,8 @@
 
 =end pod
 
-#?rakudo todo 'exception handling'
 {
-    ok( ! try { die "foo"; 1 }, 'die in try cuts off execution');
+    ok( !defined( try { die "foo"; 1; } ), 'die in try cuts off execution');
     my $error = $!;
     is($error, 'foo', 'got $! correctly');
 }
Index: S02-magicals/dollar_bang.t
===================================================================
--- S02-magicals/dollar_bang.t	(revision 28893)
+++ S02-magicals/dollar_bang.t	(working copy)
@@ -2,7 +2,7 @@
 
 use Test;
 
-plan 10;
+plan 17;
 
 =begin desc
 
@@ -53,4 +53,32 @@
 #?rakudo todo 'stringification of $!'
 ok ~($!) ~~ /qwerty/, 'die without argument uses $! properly';
 
+# RT #70011
+{
+    undefine $!;
+    try { die('goodbye'); }
+    ok defined( $!.perl ), '$! has working Perl 6 object methods after try';
+    ok ($!.WHAT ~~ Exception), '$! is Exception object after try';
+    # - S04-statements/try.t tests $! being set after try.
+    # - S29-context/die.t tests $! being set after die.
+    # - also tested more generically above.
+    # So no need to test the value of #! again here.
+    #is $!, 'goodbye', '$! has correct value after try';
+    ok ($!), '$! as boolean works (true)';
+
+    undefine $!;
+    eval q[ die('farewell'); ];
+    ok defined($!.perl), '$! has working Perl 6 object methods after eval';
+    ok ($!.WHAT ~~ Exception), '$! is Exception object after eval';
+    # Although S29-context/die.t tests $! being set after die, it's not
+    # from within an eval, so we test the eval/die combination here.
+    # As that file (and also S04-statements/try.t) do equality comparisons
+    # rather than pattern matches, we check equality here, too.
+    is $!, 'farewell', '$! has correct value after eval';
+
+    undefine $!;
+    try { 1; }
+    ok (! $!), '$! as boolean works (false)';
+}
+
 # vim: ft=perl6