develooper Front page | perl.perl5.porters | Postings from December 2000

[PATCH Opcode.XS, Perl 5.6+] stuff for caller and _ in Safe::

From:
lane
Date:
December 15, 2000 22:59
Subject:
[PATCH Opcode.XS, Perl 5.6+] stuff for caller and _ in Safe::
Message ID:
001216020006.62704@DUPHY4.Physics.Drexel.Edu
I've held onto this patch for a while; I think it really needs to
go into Opcode.xs


First, the problems:
    a) in Safe:: partitions, caller function gives the partition
        name rather than "main::" ... makes a problems for routines
        imported based on caller.

    b) in Safe:: partitions, file tests using _ don't work right
       because _ symbol isn't in the partition.
        (i.e, tests like  -r myfile.dat && -e _  will fail)

Next the diagnostic script:

#! perl
use Safe;
use Opcode;
$s = new Safe FOO;
$s->permit(':all');

# find a directory that is writable

opendir(D,'./');
while (defined($_ = readdir(D))) {
   last if -d $_ && -w _;
}
closedir(D);
$tstdir = $_;

# script to check caller()

$script = <<'THEEND';
   blem();
   sub blem {
       my @s = caller;
       $BAR = $s[0];
       print qq(caller is ),$s[0],qq(\n);
   }
THEEND

# if we have a testdirectory, add test for _

if ($tstdir) {
    $script .= 'if (-d q('.$tstdir.') && -w _) {'.qq(\n);
    $script .= '    print qq(underscore OK\n);'.qq(\n);
    $script .= '} else {'.qq(\n);
    $script .= '    print qq(underscore FAILED\n);'.qq(\n);
    $script .= '}'.qq(\n);
} else {
    $script .= 'print qq(_NOTEST\n);'.qq(\n);
}
print "Perl is ",$],qq(\n);
print "Opcode is ",$Opcode::VERSION,qq(\n);
$s->reval($script);


And finally, the patch:

Patch for Opcode for Perl >= 5.005.59

1) make routines in Safe:: partitions think they are in main::
2) connect the _ in the partition to the global _


--- ext/Opcode/Opcode.xs-orig   Wed Jul 26 07:00:15 2000
+++ ext/Opcode/Opcode.xs        Wed Jul 26 06:59:39 2000
@@ -253,6 +253,12 @@
     save_hptr(&PL_defstash);           /* save current default stack   */
     /* 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;

--
 Drexel University       \V                    --Chuck Lane
======]---------->--------*------------<-------[===========
     (215) 895-1545     _/ \  Particle Physics
FAX: (215) 895-5934     /\ /~~~~~~~~~~~        lane@duphy4.physics.drexel.edu



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About