4 require Config; import Config;
5 if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
12 use Test::More tests => 10;
14 my $safe = Safe->new('PLPerl');
15 $safe->permit_only(qw(:default sort));
17 # check basic argument passing and context for anon-subs
18 my $func = $safe->reval(q{ sub { @_ } });
19 is_deeply [ $func->() ], [ ];
20 is_deeply [ $func->("foo") ], [ "foo" ];
22 my $func1 = $safe->reval(<<'EOS');
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 } @_; }
29 return sub { return join(",",l_sort(@_)), join(",",Pkg::p_sort(@_)) }
33 is $@, '', 'reval should not fail';
34 is ref $func, 'CODE', 'reval should return a CODE ref';
36 # $func1 will work in non-threaded perl
37 # but RT#60374 "Safe.pm sort {} bug with -Dusethreads"
38 # means the sorting won't work unless we wrap the code ref
39 # such that it's executed with Safe 'in effect' at runtime
40 my $func2 = $safe->wrap_code_ref($func1);
42 my ($l_sorted, $p_sorted) = $func2->(3,1,2);
43 is $l_sorted, "1,2,3";
44 is $p_sorted, "1,2,3";
46 # check other aspects of closures created inside Safe
48 my $die_func = $safe->reval(q{ sub { die @_ if @_; 1 } });
50 # check $@ not affected by successful call
53 is $@, 42, 'successful closure call should not alter $@';
57 local $SIG{__WARN__} = sub { $warns++ };
58 ok !eval { $die_func->("died\n"); 1 }, 'should die';
59 is $@, "died\n", '$@ should be set correctly';
60 local $TODO = "Shouldn't warn";