Commit | Line | Data |
---|---|---|
33f7e1aa RGS |
1 | #!perl |
2 | ||
3 | BEGIN { | |
4 | if ($ENV{PERL_CORE}) { | |
5 | chdir 't' if -d 't'; | |
6 | @INC = '../lib'; | |
ac5e3691 AB |
7 | } |
8 | require Config; import Config; | |
9 | if ($Config{'extensions'} !~ /\bOpcode\b/ | |
10 | && $Config{'extensions'} !~ /\bPOSIX\b/ | |
11 | && $Config{'osname'} ne 'VMS') | |
12 | { | |
13 | print "1..0\n"; | |
14 | exit 0; | |
33f7e1aa RGS |
15 | } |
16 | } | |
17 | ||
18 | use strict; | |
19 | use warnings; | |
20 | use POSIX qw(ceil); | |
d00660f4 | 21 | use Test::More tests => 2; |
33f7e1aa RGS |
22 | use Safe; |
23 | ||
24 | my $safe = new Safe; | |
25 | $safe->deny('add'); | |
26 | ||
d00660f4 | 27 | my $masksize = ceil( Opcode::opcodes / 8 ); |
33f7e1aa | 28 | # Attempt to change the opmask from within the safe compartment |
d00660f4 | 29 | $safe->reval( qq{\$_[1] = qq/\0/ x } . $masksize ); |
33f7e1aa RGS |
30 | |
31 | # Check that it didn't work | |
32 | $safe->reval( q{$x + $y} ); | |
33 | like( $@, qr/^'?addition \(\+\)'? trapped by operation mask/, | |
d00660f4 RGS |
34 | 'opmask still in place with reval' ); |
35 | ||
36 | my $safe2 = new Safe; | |
37 | $safe2->deny('add'); | |
38 | ||
39 | open my $fh, '>nasty.pl' or die "Can't write nasty.pl: $!\n"; | |
40 | print $fh <<EOF; | |
41 | \$_[1] = "\0" x $masksize; | |
42 | EOF | |
43 | close $fh; | |
44 | $safe2->rdo('nasty.pl'); | |
45 | $safe2->reval( q{$x + $y} ); | |
46 | like( $@, qr/^'?addition \(\+\)'? trapped by operation mask/, | |
47 | 'opmask still in place with rdo' ); | |
48 | END { unlink 'nasty.pl' } |