diff options
| author | Jarkko Hietaniemi <jhi@iki.fi> | 1999-01-13 17:24:59 +0000 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 1999-01-13 17:24:59 +0000 |
| commit | 9c007264caa0e1aed57010dc2950fe35f9d8347e (patch) | |
| tree | 16b435433f6ef5875c593a2549690a2ec78ea3e9 /t/op | |
| parent | 61ae2fbf8676dafa05a9a9a710fde421f30a2071 (diff) | |
| download | perl-9c007264caa0e1aed57010dc2950fe35f9d8347e.tar.gz | |
From: Hans Mulder <hansm@icgroup.nl>
Optimize common sort routines. Thread started by the message
From: Hans Mulder <hansm@icgroup.nl>
Sender: owner-perl5-porters@perl.org
To: perl5-porters@perl.org
Subject: [Patch for 5.00554] From the Todo list: Optimize sort by { $a <=> $b
Message-Id: <9901092156.AA03831@icgned.icgroup.nl>
and the patch from the message
From: Hans Mulder <hans@icgroup.nl>
To: jhi@iki.fi
Cc: perl5-porters@perl.org
Subject: Re: [Patch for 5.00554] From the Todo list: Optimize sort by { $a <=>
$b }
Date: Wed, 13 Jan 1999 17:39:35 +0100
Message-Id: <9901131639.AA17419@icgned.icgroup.nl>
p4raw-id: //depot/cfgperl@2595
Diffstat (limited to 't/op')
| -rwxr-xr-x | t/op/sort.t | 42 |
1 files changed, 41 insertions, 1 deletions
diff --git a/t/op/sort.t b/t/op/sort.t index fdb4e347a5..4de5cce640 100755 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -1,6 +1,10 @@ #!./perl -print "1..29\n"; +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} +print "1..37\n"; # XXX known to leak scalars $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; @@ -157,3 +161,39 @@ print $@ ? "not ok 21\n# $@" : "ok 21\n"; print ("@b" eq '4 3 2 1' ? "ok 29\n" : "not ok 29 |@b|\n"); } +## exercise sort builtins... ($a <=> $b already tested) +@a = ( 5, 19, 1996, 255, 90 ); +@b = sort { $b <=> $a } @a; +print ("@b" eq '1996 255 90 19 5' ? "ok 30\n" : "not ok 30\n"); +print "# x = '@b'\n"; +$x = join('', sort { $a cmp $b } @harry); +$expected = $upperfirst ? 'AbelCaincatdogx' : 'catdogxAbelCain'; +print ($x eq $expected ? "ok 31\n" : "not ok 31\n"); +print "# x = '$x'; expected = '$expected'\n"; +$x = join('', sort { $b cmp $a } @harry); +$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat'; +print ($x eq $expected ? "ok 32\n" : "not ok 32\n"); +print "# x = '$x'; expected = '$expected'\n"; +{ + use integer; + @b = sort { $a <=> $b } @a; + print ("@b" eq '5 19 90 255 1996' ? "ok 33\n" : "not ok 33\n"); + print "# x = '@b'\n"; + @b = sort { $b <=> $a } @a; + print ("@b" eq '1996 255 90 19 5' ? "ok 34\n" : "not ok 34\n"); + print "# x = '@b'\n"; + $x = join('', sort { $a cmp $b } @harry); + $expected = $upperfirst ? 'AbelCaincatdogx' : 'catdogxAbelCain'; + print ($x eq $expected ? "ok 35\n" : "not ok 35\n"); + print "# x = '$x'; expected = '$expected'\n"; + $x = join('', sort { $b cmp $a } @harry); + $expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat'; + print ($x eq $expected ? "ok 36\n" : "not ok 36\n"); + print "# x = '$x'; expected = '$expected'\n"; +} +# test sorting in non-main package +package Foo; +@a = ( 5, 19, 1996, 255, 90 ); +@b = sort { $b <=> $a } @a; +print ("@b" eq '1996 255 90 19 5' ? "ok 37\n" : "not ok 37\n"); +print "# x = '@b'\n"; |