perl5.002beta3
[perl.git] / t / lib / safe.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     require Config; import Config;
7     if ($Config{'extensions'} !~ /\bSafe\b/ && $Config{'osname'} ne 'VMS') {
8         print "1..0\n";
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
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";
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";