[perl #70335] [PATCH] make dollar-bang contextual

[via RT]

# New Ticket Created by  Mark Montague 
# Please include the string:  [perl #70335]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=70335 >



Patch to make die and eval treat $! as a contextual variable.  This  
patch does not solve any reported problem, it's cleanup work suggested  
by jnthn++ during discussion of the patch for RT #70011.  Thanks to  
pmichaud++, jnthn++ for several rounds of discussion and improvements  
via #perl6.

This patch does not require any additions or changes to the spec  
tests.  r29025.

Link for easier viewing:
http://github.com/markmont/rakudo/commit/1eaaa816d8581b46ec6a882dea0889d5ea4db880

$ git pull
Already up-to-date.
$ git rev-parse HEAD
97ced10559899d15d4659ccab503edddb17742d1
$ parrot_config VERSION ; parrot_config revision
1.7.0
42366
$


--
Mark Montague
markm...@umich.edu

>From 1eaaa816d8581b46ec6a882dea0889d5ea4db880 Mon Sep 17 00:00:00 2001
From: Mark Montague <markm...@umich.edu>
Date: Sun, 8 Nov 2009 11:43:13 -0500
Subject: [PATCH] Make die treat dollar-bang as a contextual variable as this is
 "the right thing to do" (no effect on functionality or spec tests).

Finished making the changes.
---
 src/builtins/control.pir |   23 +++++++++++++----------
 src/builtins/globals.pir |    9 ++++++---
 2 files changed, 19 insertions(+), 13 deletions(-)

diff --git a/src/builtins/control.pir b/src/builtins/control.pir
index 92ae969..17d332a 100644
--- a/src/builtins/control.pir
+++ b/src/builtins/control.pir
@@ -207,30 +207,34 @@ the moment -- we'll do more complex handling a bit later.)
     .local pmc p6ex
     p6ex = new ['Perl6Exception']
     setattribute p6ex, '$!exception', ex
-    set_global '$!', p6ex
+    # Set $!  We can't use infix:= becuase it calls die, which would be bad.
+    push_eh global_dollar_bang
+    store_dynamic_lex '$!', p6ex 
+    pop_eh
+    goto done
+global_dollar_bang:
+    # $! is contextual, so if we could not set it lexically, set it globally
+    set_hll_global '$!', p6ex
+done:
     throw ex
     .return ()
 .end
 
+
 .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
-    setattribute p6ex, '$!exception', ex
-    set_global '$!', p6ex
-    throw ex
-    .return ()
+    .tailcall 'die'(ex)
 .end
 
 
@@ -403,9 +407,8 @@ on error.
     pop_eh
 
     # Propagate exception to caller
-    $P0 = getinterp
-    $P0 = $P0['lexpad';1]
-    $P0['$!'] = exception
+    $P0 = '!find_contextual'('$!')
+    'infix:='($P0, exception)
     unless null res goto with_res
     res = new ['Nil']
   with_res:
diff --git a/src/builtins/globals.pir b/src/builtins/globals.pir
index a28f27d..bef536d 100644
--- a/src/builtins/globals.pir
+++ b/src/builtins/globals.pir
@@ -113,14 +113,17 @@ src/builtins/globals.pir - initialize miscellaneous global variables
     $P0 = find_dynamic_lex name
     unless null $P0 goto done
 
-    # next, strip twigil and search PROCESS package
+    # remove twigil if it is * then search GLOBAL package, then PROCESS
     .local string pkgname
     pkgname = clone name
+    ord $I0, pkgname, 1
+    unless $I0 == 42 goto lookup
     substr pkgname, 1, 1, ''
-    $P0 = get_hll_global ['PROCESS'], pkgname
-    unless null $P0 goto done
+  lookup:
     $P0 = get_global pkgname
     unless null $P0 goto done
+    $P0 = get_hll_global ['PROCESS'], pkgname
+    unless null $P0 goto done
 
   fail:
     $P0 = '!FAIL'('Contextual ', name, ' not found')
-- 
1.6.2.5