This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[rt.cpan.org #51574] Safe.pm sort {} bug accessing $a and $b with -Dusethreads
[perl5.git] / dist / Safe / t / safesort.t
1 #!./perl -w
2 $|=1;
3 BEGIN {
4     if($ENV{PERL_CORE}) {
5         chdir 't' if -d 't';
6         @INC = '../lib';
7     }
8     require Config; import Config;
9     if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
10         print "1..0\n";
11         exit 0;
12     }
13 }
14
15 use Safe 1.00;
16 use Test::More tests => 4;
17
18 my $safe = Safe->new('PLPerl');
19 $safe->permit_only(qw(:default sort));
20
21 my $func = $safe->reval(<<'EOS');
22
23     # uses quotes in { "$a" <=> $b } to avoid the optimizer replacing the block
24     # with a hardwired comparison
25     { package Pkg; sub p_sort { return sort { "$a" <=> $b } qw(2 1 3); } }
26                    sub l_sort { return sort { "$a" <=> $b } qw(2 1 3); }
27
28     return sub { return join(",",l_sort()), join(",",Pkg::p_sort()) }
29
30 EOS
31
32 is $@, '', 'reval should not fail';
33 is ref $func, 'CODE', 'reval should return a CODE ref';
34
35 my ($l_sorted, $p_sorted) = $func->();
36 is $l_sorted, "1,2,3";
37 is $p_sorted, "1,2,3";