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

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;
 }