6 require Config; import Config;
7 if ($Config{'extensions'} !~ /\bSafe\b/) {
13 use Safe qw(opname opcode ops_to_mask mask_to_ops);
17 # Set up a package namespace of things to be visible to the unsafe code
18 $Root::foo = "visible";
20 # Stop perl from moaning about identifies which are apparently only used once
25 $cpt = new Safe "Root";
27 system("echo not ok 1");
29 if ($@ =~ /^system trapped by operation mask/) {
36 print $foo eq 'visible' ? "ok 2\n" : "not ok 2\n";
37 print $main::foo eq 'visible' ? "ok 3\n" : "not ok 3\n";
38 print defined($bar) ? "not ok 4\n" : "ok 4\n";
39 print defined($::bar) ? "not ok 5\n" : "ok 5\n";
40 print defined($main::bar) ? "not ok 6\n" : "ok 6\n";
42 print $@ ? "not ok 7\n" : "ok 7\n";
45 %bar = (key => "ok 9\n");
47 push(@baz, "10"); # Two steps to prevent "Identifier used only once..."
49 @glob = qw(not ok 16);
53 sub sayok12 { print "ok 12\n" }
55 $cpt->share(qw($foo %bar @baz *glob &sayok12 $"));
58 print $foo ? $foo : "not ok 8\n";
59 print $bar{key} ? $bar{key} : "not ok 9\n";
68 $bar{new} = "ok 15\n";
71 print $@ ? "not ok 13\n#$@" : "ok 13\n";
73 print $foo, $bar{new}, "@glob\n";
75 $Root::foo = "not ok 17";
76 @{$cpt->varglob('bar')} = qw(not ok 18);
77 ${$cpt->varglob('foo')} = "ok 17";
79 push(@Root::bar, "18"); # Two steps to prevent "Identifier used only once..."
82 print "@{$cpt->varglob('bar')}\n";
84 print opname(22) eq "bless" ? "ok 19\n" : "not ok 19\n";
85 print opcode("bless") == 22 ? "ok 20\n" : "not ok 20\n";
90 @masked = mask_to_ops($m1);
91 print $m2 eq ops_to_mask("negate", @masked) ? "ok 21\n" : "not ok 21\n";
93 substr($m2, 187, 1) = "\0";
94 print $m2 eq $cpt->mask() ? "ok 22\n" : "not ok 22\n";
96 print $cpt->reval("2 + 2") == 4 ? "ok 23\n" : "not ok 23\n";