Skip Menu |
 

This queue is for tickets about the List-MoreUtils CPAN distribution.

Report information
The Basics
Id: 39847
Status: resolved
Priority: 0/
Queue: List-MoreUtils

People
Owner: Nobody in particular
Requestors: mark_swayne [...] mac.com
Cc: ljohnson [...] cpan.org
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)

Attachments


Subject: minmax error: unpredictable results with lists of 1 element
Date: Mon, 06 Oct 2008 15:43:06 -0700
To: bug-List-MoreUtils [...] rt.cpan.org.
From: Mark Swayne <mark_swayne [...] mac.com>
Download (untitled) / with headers
text/plain 1.6k
I found this bug with L::MU 0.21 under Perl 5.8.8. When I feed the minmax function a list with one element, I get unexpected results. This script: use List::MoreUtils qw(minmax); my $test = 0; test( 1..10 ); test( 9 ); test( 0 ); test( -1 ); test(); sub test { no warnings "uninitialized"; $test++; my @result = minmax( @_ ); my $results = join "', '", @result; $results = "'$results'" if $results; print "Test $test: Result Count=".@result.", Results=$results\n"; } Produces this: Test 1: Result Count=2, Results='1', '10' Test 2: Result Count=2, Results='', '9' Test 3: Result Count=2, Results='0', '0' Test 4: Result Count=2, Results='-1', '' Test 5: Result Count=0, Results= Tests1 and 5 produce the expected results. However, Tests 2, 3 and 4 are surprising. Test 3 gives what I would consider to be correct results. If I force L::MU to use the pure perl version, I get: Test 1: Result Count=2, Results='1', '10' Test 2: Result Count=2, Results='9', '9' Test 3: Result Count=2, Results='0', '0' Test 4: Result Count=2, Results='-1', '-1' Test 5: Result Count=0, Results= Which is exactly what I would expect. I am using List::MoreUtils version 0.21 under Windows XP service pack 3. perl -v output: This is perl, v5.8.8 built for MSWin32-x86-multi-thread (with 33 registered patches, see perl -V for more detail) Copyright 1987-2006, Larry Wall Binary build 819 [267479] provided by ActiveState http://www.ActiveState.com Built Aug 29 2006 12:42:41 C:\Documents and Settings\Mark>perl -MList::MoreUtils -e "print $List::MoreUtils::VERSION 0.21 Oh, and L::MU is an incredibly useful module, thanks for all your hard work! --Mark Swayne
Subject: [PATCH] minmax error: unpredictable results with lists of 1 element
This problems stems from the final comparison done if the list has an odd number of items. When there is only one item in the list, the code uses negative indexes on @_ (line 302 pure-perl, line 1234 XS). $_[-1] works fine, but ST(-1) does not. $ ack -A5 '(items & 1|@_ & 1)' List-MoreUtils-0.22/ List-MoreUtils-0.22/lib/List/MoreUtils.pm 300: if (@_ & 1) { 301- my $i = $#_; 302- if ($_[$i-1] <= $_[$i]) { 303- $min = $_[$i-1] if $min > $_[$i-1]; 304- $max = $_[$i] if $max < $_[$i]; 305- } else { List-MoreUtils-0.22/MoreUtils.xs 1233: if (items & 1) { 1234- asv = ST(items-2); 1235- bsv = ST(items-1); 1236- a = slu_sv_value(asv); 1237- b = slu_sv_value(bsv); 1238- if (a <= b) { I've attached a patch against List-MoreUtils-0.22 that adds a base case for a one-item list and corresponding test cases. It also adds a test case for an empty list and fixes the test number comments in t/List-MoreUtils.t. This is my first time writing XS, so please apply a critical eye before using the patch.
diff -Nuar List-MoreUtils-0.22/MoreUtils.xs List-MoreUtils-0.22-minmax-fix/MoreUtils.xs --- List-MoreUtils-0.22/MoreUtils.xs 2006-07-02 10:25:16.000000000 -0500 +++ List-MoreUtils-0.22-minmax-fix/MoreUtils.xs 2009-01-15 10:13:29.000000000 -0600 @@ -1204,6 +1204,14 @@ minsv = maxsv = ST(0); min = max = slu_sv_value(minsv); + if (items == 1) { + EXTEND(SP, 1); + ST(0) = minsv; + ST(1) = maxsv; + + XSRETURN(2); + } + for (i = 1; i < items; i += 2) { asv = ST(i-1); bsv = ST(i); diff -Nuar List-MoreUtils-0.22/lib/List/MoreUtils.pm List-MoreUtils-0.22-minmax-fix/lib/List/MoreUtils.pm --- List-MoreUtils-0.22/lib/List/MoreUtils.pm 2006-07-02 10:26:35.000000000 -0500 +++ List-MoreUtils-0.22-minmax-fix/lib/List/MoreUtils.pm 2009-01-14 15:49:00.000000000 -0600 @@ -287,6 +287,8 @@ return if ! @_; my $min = my $max = $_[0]; + return ($min, $max) if @_ == 1; + for (my $i = 1; $i < @_; $i += 2) { if ($_[$i-1] <= $_[$i]) { $min = $_[$i-1] if $min > $_[$i-1]; diff -Nuar List-MoreUtils-0.22/t/List-MoreUtils-pp.t List-MoreUtils-0.22-minmax-fix/t/List-MoreUtils-pp.t --- List-MoreUtils-0.22/t/List-MoreUtils-pp.t 2006-07-02 10:12:05.000000000 -0500 +++ List-MoreUtils-0.22-minmax-fix/t/List-MoreUtils-pp.t 2009-01-15 10:44:02.000000000 -0600 @@ -458,7 +458,7 @@ } #minmax(104...) -BEGIN { $TESTS += 6 } +BEGIN { $TESTS += 14 } { my @list = reverse 0 .. 100_000; my ($min, $max) = minmax @list; @@ -477,9 +477,23 @@ # floating-point comparison cunningly avoided ok(sprintf("%i", $min), -3); ok($max, 100_000); + + # single item + for (9, 0, 1) { + @list = ($_); + ($min, $max) = minmax(@list); + ok($min, $_); + ok($max, $_); + } + + # no items + @list = (); + ($min, $max) = minmax(@list); + ok(!defined $min); + ok(!defined $max); } -#part(110...) +#part(118...) BEGIN { $TESTS += 14 } { my @list = 1 .. 12; diff -Nuar List-MoreUtils-0.22/t/List-MoreUtils.t List-MoreUtils-0.22-minmax-fix/t/List-MoreUtils.t --- List-MoreUtils-0.22/t/List-MoreUtils.t 2006-07-02 10:12:05.000000000 -0500 +++ List-MoreUtils-0.22-minmax-fix/t/List-MoreUtils.t 2009-01-15 10:44:20.000000000 -0600 @@ -228,7 +228,7 @@ ok(!@x); } -#lastval/last_value (67...) +#lastval/last_value (66...) BEGIN { $TESTS += 4 } { my $x = last_value {$_ > 5} 4..9; @@ -242,7 +242,7 @@ ok(!defined $x); } -#firstval/first_value (71...) +#firstval/first_value (70...) BEGIN { $TESTS += 4 } { my $x = first_value {$_ > 5} 4..9; @@ -257,7 +257,7 @@ } -#each_array (75...) +#each_array (74...) BEGIN { $TESTS += 10 } { my @a = (7, 3, 'a', undef, 'r'); @@ -313,7 +313,7 @@ ok(arrayeq(\@b, ['A' .. 'Z'])); } -#each_array (85...) +#each_array (84...) BEGIN { $TESTS += 5 } { my @a = (7, 3, 'a', undef, 'r'); @@ -349,7 +349,7 @@ } -#pairwise (90...) +#pairwise (89...) BEGIN { $TESTS += 10 } { my @a = (1, 2, 3, 4, 5); @@ -416,7 +416,7 @@ ok($@, "I died\n"); } -#natatime (100...) +#natatime (99...) BEGIN { $TESTS += 3 } { my @x = ('a'..'g'); @@ -445,7 +445,7 @@ ok(arrayeq(\@r, [1 .. 26]), 1, "natatime3"); } -#mesh (103...) +#mesh (102...) BEGIN { $TESTS += 3 } { my @x = qw/a b c d/; @@ -466,7 +466,7 @@ 6, undef, 7, undef, 8, undef, 9, undef, 10, undef])); } -#zip (just an alias for mesh) (106...) +#zip (just an alias for mesh) (105...) BEGIN { $TESTS += 3 } { my @x = qw/a b c d/; @@ -487,7 +487,7 @@ 6, undef, 7, undef, 8, undef, 9, undef, 10, undef])); } -#uniq (109...) +#uniq (108...) BEGIN { $TESTS += 2 } { my @a = map { (1 .. 10000) } 0 .. 1; @@ -497,8 +497,8 @@ ok(10000, $u); } -#minmax (111...) -BEGIN { $TESTS += 6 } +#minmax (110...) +BEGIN { $TESTS += 14 } { my @list = reverse 0 .. 100_000; my ($min, $max) = minmax(@list); @@ -517,9 +517,25 @@ # floating-point comparison cunningly avoided ok(sprintf("%.2f", $min), "-3.33"); ok($max, 100_000); + + # used to return old stack items for min/max + # done multiple times so old stack problem appears + # see: CPAN RT 39847 + for (9, 0, 1) { + @list = ($_); + ($min, $max) = minmax(@list); + ok($min, $_); + ok($max, $_); + } + + # no items + @list = (); + ($min, $max) = minmax(@list); + ok(!defined $min); + ok(!defined $max); } -#part (116...) +#part (124...) BEGIN { $TESTS += 24 } { my @list = 1 .. 12;
This is resolved in 0.23 which I just uploaded to the CPAN.
Download (untitled) / with headers
text/plain 265b
On Sun Jul 12 14:58:23 2009, VPARSEVAL wrote: Show quoted text
> This is resolved in 0.23 which I just uploaded to the CPAN.
Note that the 0.23 code line is no longer in the latest release, 0.26. Consequently this and a number of other tickets in this queue are no longer resolved.
Download (untitled) / with headers
text/plain 356b
This is resolved again in 0.27_01 On Mon Nov 29 13:18:38 2010, ETHER wrote: Show quoted text
> On Sun Jul 12 14:58:23 2009, VPARSEVAL wrote:
> > This is resolved in 0.23 which I just uploaded to the CPAN.
> > Note that the 0.23 code line is no longer in the latest release, 0.26. > Consequently this and a number of other tickets in this queue are no > longer resolved.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.