1N/A#!perl -w
1N/A
1N/ABEGIN {
1N/A require Config; import Config;
1N/A if ($Config{'extensions'} !~ /\bOpcode\b/
1N/A && $Config{'extensions'} !~ /\bPOSIX\b/
1N/A && $Config{'osname'} ne 'VMS')
1N/A {
1N/A print "1..0\n";
1N/A exit 0;
1N/A }
1N/A}
1N/A
1N/Ause strict;
1N/Ause warnings;
1N/Ause POSIX qw(ceil);
1N/Ause Test::More tests => 2;
1N/Ause Safe;
1N/A
1N/Amy $safe = new Safe;
1N/A$safe->deny('add');
1N/A
1N/Amy $masksize = ceil( Opcode::opcodes / 8 );
1N/A# Attempt to change the opmask from within the safe compartment
1N/A$safe->reval( qq{\$_[1] = qq/\0/ x } . $masksize );
1N/A
1N/A# Check that it didn't work
1N/A$safe->reval( q{$x + $y} );
1N/A# Written this way to keep the Test::More that comes with perl 5.6.2 happy
1N/Aok( $@ =~ /^'?addition \(\+\)'? trapped by operation mask/,
1N/A 'opmask still in place with reval' );
1N/A
1N/Amy $safe2 = new Safe;
1N/A$safe2->deny('add');
1N/A
1N/Aopen my $fh, '>nasty.pl' or die "Can't write nasty.pl: $!\n";
1N/Aprint $fh <<EOF;
1N/A\$_[1] = "\0" x $masksize;
1N/AEOF
1N/Aclose $fh;
1N/A$safe2->rdo('nasty.pl');
1N/A$safe2->reval( q{$x + $y} );
1N/A# Written this way to keep the Test::More that comes with perl 5.6.2 happy
1N/Aok( $@ =~ /^'?addition \(\+\)'? trapped by operation mask/,
1N/A 'opmask still in place with rdo' );
1N/AEND { unlink 'nasty.pl' }