1N/A#!perl -w
1N/A
1N/A$|=1;
1N/ABEGIN {
1N/A require Config; import Config;
1N/A if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
1N/A print "1..0\n";
1N/A exit 0;
1N/A }
1N/A}
1N/A
1N/Ause strict;
1N/Ause Safe 1.00;
1N/Ause Test::More tests => 10;
1N/A
1N/Amy $safe = Safe->new('PLPerl');
1N/A$safe->permit_only(qw(:default sort));
1N/A
1N/A# eval within an eval: the outer eval is compiled into the sub, the inner is
1N/A# compiled (by the outer) at runtime and so is subject to runtime opmask
1N/Amy $sub1 = sub { eval " eval '1+1' " };
1N/Ais $sub1->(), 2;
1N/A
1N/Amy $sub1w = $safe->wrap_code_ref($sub1);
1N/Ais ref $sub1w, 'CODE';
1N/Ais eval { $sub1w->() }, undef;
1N/Alike $@, qr/eval .* trapped by operation mask/;
1N/A
1N/Ais $sub1->(), 2, 'original ref should be unaffected';
1N/A
1N/A# setup args for wrap_code_refs_within including nested data
1N/Amy @args = (42, [[ 0, { sub => $sub1 }, 2 ]], 24);
1N/Ais $args[1][0][1]{sub}, $sub1;
1N/A
1N/A$safe->wrap_code_refs_within(@args);
1N/Amy $sub1w2 = $args[1][0][1]{sub};
1N/Aisnt $sub1w2, $sub1;
1N/Ais eval { $sub1w2->() }, undef;
1N/Alike $@, qr/eval .* trapped by operation mask/;
1N/A
1N/A# Avoid infinite recursion when looking for coderefs
1N/Amy $r = $safe->reval(<<'END');
1N/A%a = ();
1N/A%b = (a => \%a);
1N/A$a{b} = \%b;
1N/A42;
1N/AEND
1N/Ais($r, 42);