From 8c7314f9ab22287a19960f7531f5ca7120cc6843 Mon Sep 17 00:00:00 2001
From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Tue, 23 Jan 2001 14:22:32 +0000
Subject: A bug introduced in #8217 (the undefined variable in the lib/safe1_t
 #3) fixed, by Charles Lane:

The earlier patch made it so that stuff running in Safe
compartments could do a "caller" and see "main".  That
little change in name is done right before the code in
the compartment is run, and apparantly the parser
was picking up the stash name before it got changed.

(why it was threaded vs. unthreaded Perl that was sensitive to this
I still don't know...and it probably doesn't matter).

I tryed removing the stash name-change and saw that threaded Perl
did indeed pass the lib/safe1.t tests.

So here's a patch; a routine (_safe_pkg_prep) is added to Opcode to
do the name change (and to connect _ in the compartment to the global
_) which is removed from _safe_call_sv.   Then Safe.pm is modified
to call _safe_pkg_prep when creating a new compartment.

Passes all tests with threaded perl on linux; passes all tests
with unthreaded perl on VMS.

At some point I'll probably want to revisit Safe and Opcode to
provide more sensible handling of global variables...and to get
formats working in Safe compartments, which they don't do currently.

p4raw-id: //depot/perl@8524
---
 ext/Opcode/Opcode.xs | 27 +++++++++++++++++++++------
 ext/Opcode/Safe.pm   |  1 +
 2 files changed, 22 insertions(+), 6 deletions(-)

diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs
index d437cd7a6a..e294059856 100644
--- a/ext/Opcode/Opcode.xs
+++ b/ext/Opcode/Opcode.xs
@@ -233,6 +233,26 @@ BOOT:
 	warn("opset_len %ld\n", (long)opset_len);
     op_names_init(aTHX);
 
+void
+_safe_pkg_prep(Package)
+    char *	Package
+PPCODE:
+    HV *hv; 
+    ENTER;
+   
+    hv = gv_stashpv(Package, GV_ADDWARN); /* should exist already	*/
+
+    if (strNE(HvNAME(hv),"main")) {
+        Safefree(HvNAME(hv));         
+        HvNAME(hv) = savepv("main"); /* make it think it's in main:: */
+        hv_store(hv,"_",1,(SV *)PL_defgv,0);  /* connect _ to global */
+        SvREFCNT_inc((SV *)PL_defgv);  /* want to keep _ around! */
+    }
+    LEAVE;
+
+
+
+
 
 void
 _safe_call_sv(Package, mask, codesv)
@@ -253,12 +273,7 @@ PPCODE:
     save_hptr(&PL_defstash);		/* save current default stash	*/
     /* the assignment to global defstash changes our sense of 'main'	*/
     PL_defstash = gv_stashpv(Package, GV_ADDWARN); /* should exist already	*/
-    if (strNE(HvNAME(PL_defstash),"main")) {
-        Safefree(HvNAME(PL_defstash));         
-        HvNAME(PL_defstash) = savepv("main"); /* make it think it's in main:: */
-        hv_store(PL_defstash,"_",1,(SV *)PL_defgv,0);  /* connect _ to global */
-        SvREFCNT_inc((SV *)PL_defgv);  /* want to keep _ around! */
-    }
+
     save_hptr(&PL_curstash);
     PL_curstash = PL_defstash;
 
diff --git a/ext/Opcode/Safe.pm b/ext/Opcode/Safe.pm
index 7e1d6a34a7..a803b5f12d 100644
--- a/ext/Opcode/Safe.pm
+++ b/ext/Opcode/Safe.pm
@@ -47,6 +47,7 @@ sub new {
     # the whole glob *_ rather than $_ and @_ separately, otherwise
     # @_ in non default packages within the compartment don't work.
     $obj->share_from('main', $default_share);
+    Opcode::_safe_pkg_prep($obj->{Root});
     return $obj;
 }
 
-- 
cgit v1.2.1