1#!perl -w 2 3$|=1; 4BEGIN { 5 require Config; import Config; 6 if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') { 7 print "1..0\n"; 8 exit 0; 9 } 10} 11 12use strict; 13use Safe 1.00; 14use Test::More tests => 10; 15 16my $safe = Safe->new('PLPerl'); 17$safe->permit_only(qw(:default sort)); 18 19# eval within an eval: the outer eval is compiled into the sub, the inner is 20# compiled (by the outer) at runtime and so is subject to runtime opmask 21my $sub1 = sub { eval " eval '1+1' " }; 22is $sub1->(), 2; 23 24my $sub1w = $safe->wrap_code_ref($sub1); 25is ref $sub1w, 'CODE'; 26is eval { $sub1w->() }, undef; 27like $@, qr/eval .* trapped by operation mask/; 28 29is $sub1->(), 2, 'original ref should be unaffected'; 30 31# setup args for wrap_code_refs_within including nested data 32my @args = (42, [[ 0, { sub => $sub1 }, 2 ]], 24); 33is $args[1][0][1]{sub}, $sub1; 34 35$safe->wrap_code_refs_within(@args); 36my $sub1w2 = $args[1][0][1]{sub}; 37isnt $sub1w2, $sub1; 38is eval { $sub1w2->() }, undef; 39like $@, qr/eval .* trapped by operation mask/; 40 41# Avoid infinite recursion when looking for coderefs 42my $r = $safe->reval(<<'END'); 43%a = (); 44%b = (a => \%a); 45$a{b} = \%b; 4642; 47END 48is($r, 42); 49