This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Silence spurious warning in new Safe test
[perl5.git] / dist / Safe / t / safesort.t
CommitLineData
9d5fa2fe 1#!perl -w
576b33a1
TB
2$|=1;
3BEGIN {
576b33a1
TB
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;
fda8057a 12use Test::More tests => 10;
576b33a1
TB
13
14my $safe = Safe->new('PLPerl');
15$safe->permit_only(qw(:default sort));
16
32f28238
TB
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
bb92c766 22$func = $safe->reval(<<'EOS');
576b33a1
TB
23
24 # uses quotes in { "$a" <=> $b } to avoid the optimizer replacing the block
25 # with a hardwired comparison
32f28238
TB
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
TB
30
31EOS
32
33is $@, '', 'reval should not fail';
34is ref $func, 'CODE', 'reval should return a CODE ref';
35
bb92c766 36my ($l_sorted, $p_sorted) = $func->(1,2,3);
576b33a1
TB
37is $l_sorted, "1,2,3";
38is $p_sorted, "1,2,3";
2630fd9e
TB
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
fda8057a
RGS
49{
50 my $warns = 0;
51 local $SIG{__WARN__} = sub { $warns++ };
52 ok !eval { $die_func->("died\n"); 1 }, 'should die';
53 is $@, "died\n", '$@ should be set correctly';
54 local $TODO = "Shouldn't warn";
55 is $warns, 0;
56}