Commit | Line | Data |
7026dc70 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | require Config; import Config; |
f360dba1 |
7 | if ($Config{'extensions'} !~ /\bSafe\b/ && $^O ne 'VMS') { |
fe983fe5 |
8 | print "1..0\n"; |
7026dc70 |
9 | exit 0; |
10 | } |
11 | } |
12 | |
13 | use Safe qw(opname opcode ops_to_mask mask_to_ops); |
14 | |
15 | print "1..23\n"; |
16 | |
17 | # Set up a package namespace of things to be visible to the unsafe code |
18 | $Root::foo = "visible"; |
19 | |
20 | # Stop perl from moaning about identifies which are apparently only used once |
21 | $Root::foo .= ""; |
22 | $bar .= ""; |
23 | |
24 | $bar = "invisible"; |
25 | $cpt = new Safe "Root"; |
26 | $cpt->reval(q{ |
27 | system("echo not ok 1"); |
28 | }); |
29 | if ($@ =~ /^system trapped by operation mask/) { |
30 | print "ok 1\n"; |
31 | } else { |
32 | print "not ok 1\n"; |
33 | } |
34 | |
35 | $cpt->reval(q{ |
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"; |
41 | }); |
42 | print $@ ? "not ok 7\n" : "ok 7\n"; |
43 | |
44 | $foo = "ok 8\n"; |
45 | %bar = (key => "ok 9\n"); |
46 | @baz = "o"; |
47 | push(@baz, "10"); # Two steps to prevent "Identifier used only once..." |
48 | $glob = "ok 11\n"; |
49 | @glob = qw(not ok 16); |
50 | |
51 | $" = 'k '; |
52 | |
53 | sub sayok12 { print "ok 12\n" } |
54 | |
55 | $cpt->share(qw($foo %bar @baz *glob &sayok12 $")); |
56 | |
57 | $cpt->reval(q{ |
58 | print $foo ? $foo : "not ok 8\n"; |
59 | print $bar{key} ? $bar{key} : "not ok 9\n"; |
60 | if (@baz) { |
61 | print "@baz\n"; |
62 | } else { |
63 | print "not ok 10\n"; |
64 | } |
65 | print $glob; |
66 | sayok12(); |
67 | $foo =~ s/8/14/; |
68 | $bar{new} = "ok 15\n"; |
69 | @glob = qw(ok 16); |
70 | }); |
71 | print $@ ? "not ok 13\n#$@" : "ok 13\n"; |
72 | $" = ' '; |
73 | print $foo, $bar{new}, "@glob\n"; |
74 | |
75 | $Root::foo = "not ok 17"; |
76 | @{$cpt->varglob('bar')} = qw(not ok 18); |
77 | ${$cpt->varglob('foo')} = "ok 17"; |
78 | @Root::bar = "ok"; |
79 | push(@Root::bar, "18"); # Two steps to prevent "Identifier used only once..." |
80 | |
81 | print "$Root::foo\n"; |
82 | print "@{$cpt->varglob('bar')}\n"; |
83 | |
c07a80fd |
84 | print opname(23) eq "bless" ? "ok 19\n" : "not ok 19\n"; |
85 | print opcode("bless") == 23 ? "ok 20\n" : "not ok 20\n"; |
7026dc70 |
86 | |
87 | $m1 = $cpt->mask(); |
88 | $cpt->trap("negate"); |
89 | $m2 = $cpt->mask(); |
90 | @masked = mask_to_ops($m1); |
91 | print $m2 eq ops_to_mask("negate", @masked) ? "ok 21\n" : "not ok 21\n"; |
92 | $cpt->untrap(187); |
93 | substr($m2, 187, 1) = "\0"; |
94 | print $m2 eq $cpt->mask() ? "ok 22\n" : "not ok 22\n"; |
95 | |
96 | print $cpt->reval("2 + 2") == 4 ? "ok 23\n" : "not ok 23\n"; |