blob: c7669a05e4e8de0f9052f001060e1e378d0ae4b3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
#!./perl
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
if ($Config{'extensions'} !~ /\bSafe\b/) {
print "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";
|
