Commit | Line | Data |
9d5fa2fe |
1 | #!perl -w |
576b33a1 |
2 | $|=1; |
3 | BEGIN { |
576b33a1 |
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 | |
11 | use Safe 1.00; |
2630fd9e |
12 | use Test::More tests => 9; |
576b33a1 |
13 | |
14 | my $safe = Safe->new('PLPerl'); |
15 | $safe->permit_only(qw(:default sort)); |
16 | |
32f28238 |
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" ]; |
21 | |
bb92c766 |
22 | $func = $safe->reval(<<'EOS'); |
576b33a1 |
23 | |
24 | # uses quotes in { "$a" <=> $b } to avoid the optimizer replacing the block |
25 | # with a hardwired comparison |
32f28238 |
26 | { package Pkg; sub p_sort { return sort { "$a" <=> $b } @_; } } |
27 | sub l_sort { return sort { "$a" <=> $b } @_; } |
576b33a1 |
28 | |
32f28238 |
29 | return sub { return join(",",l_sort(@_)), join(",",Pkg::p_sort(@_)) } |
576b33a1 |
30 | |
31 | EOS |
32 | |
33 | is $@, '', 'reval should not fail'; |
34 | is ref $func, 'CODE', 'reval should return a CODE ref'; |
35 | |
bb92c766 |
36 | my ($l_sorted, $p_sorted) = $func->(1,2,3); |
576b33a1 |
37 | is $l_sorted, "1,2,3"; |
38 | is $p_sorted, "1,2,3"; |
2630fd9e |
39 | |
40 | # check other aspects of closures created inside Safe |
41 | |
42 | my $die_func = $safe->reval(q{ sub { die @_ if @_; 1 } }); |
43 | |
44 | # check $@ not affected by successful call |
45 | $@ = 42; |
46 | $die_func->(); |
47 | is $@, 42, 'successful closure call should not alter $@'; |
48 | |
49 | ok !eval { $die_func->("died\n"); 1 }, 'should die'; |
50 | is $@, "died\n", '$@ should be set correctly'; |
51 | |