In case it's useful to anybody else here's a patch which I believe pulls
the Safe extension in the distributed 1g back into line.
*** 1.1 1995/12/07 10:46:18
--- op.c 1995/12/15 16:35:25
***************
*** 18,23 ****
--- 18,24 ----
#include "EXTERN.h"
#include "perl.h"
+ #define USE_OP_MASK
#ifdef USE_OP_MASK
/*
* In the following definition, the ", (OP *) op" is just to make the compiler
*** 1.1 1995/12/07 10:46:18
--- perl.h 1995/12/15 16:39:32
***************
*** 854,859 ****
--- 854,860 ----
EXT char ** origenviron;
EXT U32 origalen;
EXT U32 * profiledata;
+ EXT int maxo INIT(MAXO);/* Number of ops */
EXT XPV* xiv_arenaroot; /* list of allocated xiv areas */
EXT IV ** xiv_root; /* free xiv list--shared by interpreters */
*** 1.1 1995/12/07 10:46:18
--- embed.h 1995/12/15 16:41:02
***************
*** 99,104 ****
--- 99,105 ----
#define markstack Perl_markstack
#define markstack_max Perl_markstack_max
#define markstack_ptr Perl_markstack_ptr
+ #define maxo Perl_maxo
#define max_intro_pending Perl_max_intro_pending
#define min_intro_pending Perl_min_intro_pending
#define mod_amg Perl_mod_amg
*** MANIFEST.ORI Fri Dec 15 15:12:18 1995
--- MANIFEST Fri Dec 15 16:55:30 1995
***************
*** 116,121 ****
--- 116,124 ----
ext/POSIX/POSIX.pod POSIX extension documentation
ext/POSIX/POSIX.xs POSIX extension external subroutines
ext/POSIX/typemap POSIX extension interface types
+ ext/Safe/Makefile.PL Safe extension makefile writer
+ ext/Safe/Safe.pm Safe extension Perl module
+ ext/Safe/Safe.xs Safe extension external subroutines
ext/SDBM_File/Makefile.PL SDBM extension makefile writer
ext/SDBM_File/SDBM_File.pm SDBM extension Perl module
ext/SDBM_File/SDBM_File.xs SDBM extension external subroutines
***************
*** 453,458 ****
--- 456,462 ----
t/lib/ndbm.t See if NDBM_File works
t/lib/odbm.t See if ODBM_File works
t/lib/posix.t See if POSIX works
+ t/lib/safe.t See if Safe works
t/lib/sdbm.t See if SDBM_File works
t/lib/socket.t See if Socket works
t/lib/soundex.t See if Soundex works
*** global.sym.ORI Fri Dec 15 16:36:43 1995
--- global.sym Fri Dec 15 16:36:56 1995
***************
*** 96,101 ****
--- 96,102 ----
markstack
markstack_max
markstack_ptr
+ maxo
max_intro_pending
min_intro_pending
mod_amg
*** /dev/null Fri Dec 15 17:36:11 1995
--- t/lib/safe.t Fri Dec 15 17:29:15 1995
***************
*** 0 ****
--- 1,96 ----
+ #!./perl
+
+ BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bSafe\b/) {
+ print STDERR "1..0\n";
+ exit 0;
+ }
+ }
+
+ use Safe qw(opname opcode ops_to_mask mask_to_ops);
+
+ print "1..23\n";
+
+ # Set up a package namespace of things to be visible to the unsafe code
+ $Root::foo = "visible";
+
+ # Stop perl from moaning about identifies which are apparently only used once
+ $Root::foo .= "";
+ $bar .= "";
+
+ $bar = "invisible";
+ $cpt = new Safe "Root";
+ $cpt->reval(q{
+ system("echo not ok 1");
+ });
+ if ($@ =~ /^system trapped by operation mask/) {
+ print "ok 1\n";
+ } else {
+ print "not ok 1\n";
+ }
+
+ $cpt->reval(q{
+ print $foo eq 'visible' ? "ok 2\n" : "not ok 2\n";
+ print $main::foo eq 'visible' ? "ok 3\n" : "not ok 3\n";
+ print defined($bar) ? "not ok 4\n" : "ok 4\n";
+ print defined($::bar) ? "not ok 5\n" : "ok 5\n";
+ print defined($main::bar) ? "not ok 6\n" : "ok 6\n";
+ });
+ print $@ ? "not ok 7\n" : "ok 7\n";
+
+ $foo = "ok 8\n";
+ %bar = (key => "ok 9\n");
+ @baz = "o";
+ push(@baz, "10"); # Two steps to prevent "Identifier used only once..."
+ $glob = "ok 11\n";
+ @glob = qw(not ok 16);
+
+ $" = 'k ';
+
+ sub sayok12 { print "ok 12\n" }
+
+ $cpt->share(qw($foo %bar @baz *glob &sayok12 $"));
+
+ $cpt->reval(q{
+ print $foo ? $foo : "not ok 8\n";
+ print $bar{key} ? $bar{key} : "not ok 9\n";
+ if (@baz) {
+ print "@baz\n";
+ } else {
+ print "not ok 10\n";
+ }
+ print $glob;
+ sayok12();
+ $foo =~ s/8/14/;
+ $bar{new} = "ok 15\n";
+ @glob = qw(ok 16);
+ });
+ print $@ ? "not ok 13\n#$@" : "ok 13\n";
+ $" = ' ';
+ print $foo, $bar{new}, "@glob\n";
+
+ $Root::foo = "not ok 17";
+ @{$cpt->varglob('bar')} = qw(not ok 18);
+ ${$cpt->varglob('foo')} = "ok 17";
+ @Root::bar = "ok";
+ push(@Root::bar, "18"); # Two steps to prevent "Identifier used only once..."
+
+ print "$Root::foo\n";
+ print "@{$cpt->varglob('bar')}\n";
+
+ print opname(22) eq "bless" ? "ok 19\n" : "not ok 19\n";
+ print opcode("bless") == 22 ? "ok 20\n" : "not ok 20\n";
+
+ $m1 = $cpt->mask();
+ $cpt->trap("negate");
+ $m2 = $cpt->mask();
+ @masked = mask_to_ops($m1);
+ print $m2 eq ops_to_mask("negate", @masked) ? "ok 21\n" : "not ok 21\n";
+ $cpt->untrap(187);
+ substr($m2, 187, 1) = "\0";
+ print $m2 eq $cpt->mask() ? "ok 22\n" : "not ok 22\n";
+
+ print $cpt->reval("2 + 2") == 4 ? "ok 23\n" : "not ok 23\n";
--
Roderick Schertler
roderick@gate.net