1#!perl -w 2$|=1; 3BEGIN { 4 require Config; import Config; 5 if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') { 6 print "1..0\n"; 7 exit 0; 8 } 9} 10 11use Safe 1.00; 12use Test::More tests => 10; 13 14my $safe = Safe->new('PLPerl'); 15$safe->permit_only(qw(:default sort)); 16 17# check basic argument passing and context for anon-subs 18my $func = $safe->reval(q{ sub { @_ } }); 19is_deeply [ $func->() ], [ ]; 20is_deeply [ $func->("foo") ], [ "foo" ]; 21 22my $func1 = $safe->reval(<<'EOS'); 23 24 # uses quotes in { "$a" <=> $b } to avoid the optimizer replacing the block 25 # with a hardwired comparison 26 { package Pkg; sub p_sort { return sort { "$a" <=> $b } @_; } } 27 sub l_sort { return sort { "$a" <=> $b } @_; } 28 29 return sub { return join(",",l_sort(@_)), join(",",Pkg::p_sort(@_)) } 30 31EOS 32 33is $@, '', 'reval should not fail'; 34is ref $func, 'CODE', 'reval should return a CODE ref'; 35 36my ($l_sorted, $p_sorted) = $func1->(3,1,2); 37is $l_sorted, "1,2,3"; 38is $p_sorted, "1,2,3"; 39 40# check other aspects of closures created inside Safe 41 42my $die_func = $safe->reval(q{ sub { die @_ if @_; 1 } }); 43 44# check $@ not affected by successful call 45$@ = 42; 46$die_func->(); 47is $@, 42, 'successful closure call should not alter $@'; 48 49{ 50 my $warns = 0; 51 local $SIG{__WARN__} = sub { $warns++ }; 52 local $TODO = $] >= 5.013 ? "Doesn't die in 5.13" : undef; 53 ok !eval { $die_func->("died\n"); 1 }, 'should die'; 54 is $@, "died\n", '$@ should be set correctly'; 55 local $TODO = "Shouldn't warn"; 56 is $warns, 0; 57} 58