undef tests and docs for undef/non-numeric arg handling

lib/List/Util.pm

@@ -131,6 +131,16 @@ block that accumulates lengths by writing this instead as:
 The remaining list-reduction functions are all specialisations of this generic
 idea.
 
+For functions operating specifically on numbers, non-numerical values, such as
+undef and strings, are compared like core numeric operators do; namely by
+treating them as zero and raising a warning in the uninitialized or numeric
+categories.
+
+For string-specific functions undef is also compared like core string operators
+do; namely by treating undef as an empty string and raising a warning in the
+uninitialized category.
+
+
 =head2 any
 
     my $bool = any { BLOCK } @list;

t/dualvar.t

@@ -6,7 +6,7 @@ use warnings;
 use Scalar::Util ();
 use Test::More  (grep { /dualvar/ } @Scalar::Util::EXPORT_FAIL)
 			? (skip_all => 'dualvar requires XS version')
-			: (tests => 41);
+			: (tests => 55);
 use Config;
 
 Scalar::Util->import('dualvar');
@@ -131,3 +131,28 @@ SKIP: {
   ok(isdual($ary[2]), 'Is a dualvar');
 }
 
+ok !eval { dualvar() }, "arg count gets checked";
+ok !eval { dualvar(2, "a", "meep") }, "arg count gets checked";
+
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
+
+  my $var = dualvar(undef, undef);
+  like($warning, qr/Use of uninitialized value in subroutine entry/, 'undef arg warning');
+  ok( isdual($var),	'Is a dualvar');
+  ok( $var == undef, 'Numeric value');
+  ok( $var eq undef, 'String value');
+
+  my $var2 = dualvar(2.2, undef);
+  like($warning, qr/Use of uninitialized value in subroutine entry/, 'undef arg warning');
+  ok( isdual($var2), 'Is a dualvar');
+  ok( $var2 == 2.2, 'Numeric value');
+  ok( $var2 eq undef, 'String value');
+
+  my $var3 = dualvar(undef, "string");
+  like($warning, qr/Use of uninitialized value in subroutine entry/, 'undef arg warning');
+  ok( isdual($var3), 'Is a dualvar');
+  ok( $var3 == undef, 'Numeric value');
+  ok( $var3 eq "string", 'String value');
+}

t/isvstring.t

@@ -7,7 +7,7 @@ $|=1;
 use Scalar::Util ();
 use Test::More  (grep { /isvstring/ } @Scalar::Util::EXPORT_FAIL)
 			? (skip_all => 'isvstring requires XS version')
-			: (tests => 3);
+			: (tests => 7);
 
 Scalar::Util->import(qw[isvstring]);
 
@@ -19,5 +19,13 @@ ok( isvstring($vs),	'isvstring');
 my $sv = "1.0";
 ok( !isvstring($sv),	'not isvstring');
 
+ok !eval { isvstring() }, "arg count gets checked";
+ok !eval { isvstring(2, "a") }, "arg count gets checked";
 
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
 
+  ok(!isvstring(undef), 'undef is no ivstring');
+  is($warning, undef, 'no undef arg warning');
+}

t/max.t

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 10;
+use Test::More tests => 18;
 use List::Util qw(max);
 
 my $v;
@@ -63,3 +63,20 @@ is($v, $v1, 'bigint and normal int');
 $v = max(1, 2, $v1, 3);
 is($v, $v1, 'bigint and normal int');
 
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
+
+  is(max(), undef, 'no arg');
+  is($warning, undef, 'no args no warning');
+
+  is(max(undef), undef, 'undef arg');
+  like($warning, qr/Use of uninitialized value in subroutine entry/, 'undef arg warning');
+
+  is(max("a"), "a", 'non-numeric arg');
+  like($warning, qr/Argument "a" isn't numeric in subroutine entry/, 'non-numeric arg warning');
+
+  is(max(2, undef), 2, 'undef is smaller than 2');
+
+  is(max(-2, undef), undef, 'undef is larger than -2');
+}

t/maxstr.t

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 5;
+use Test::More tests => 12;
 use List::Util qw(maxstr);
 
 my $v;
@@ -23,3 +23,19 @@ my @a = map { pack("u", pack("C*",map { int(rand(256))} (0..int(rand(10) + 2))))
 my @b = sort { $a cmp $b } @a;
 $v = maxstr(@a);
 is($v, $b[-1], 'random ordered');
+
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
+
+  is(maxstr(), undef, 'no arg');
+  is($warning, undef, 'no args no warning');
+
+  is(maxstr(undef), undef, 'single undef arg');
+  is($warning, undef, 'no single undef arg warning'); # XXX
+
+  is(maxstr(undef, undef), undef, 'two undef arg');
+  like($warning, qr/Use of uninitialized value in subroutine entry/, 'two undef arg warning');
+
+  is(maxstr("a", undef), "a", 'undef is not gt anything');
+}

t/min.t

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 22;
+use Test::More tests => 30;
 use List::Util qw(min);
 
 my $v;
@@ -80,3 +80,21 @@ is($v, 1, 'bigint and normal int');
         ok( $max == $size-1, "max(\$#list, 0) == $size-1");
     }
 }
+
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
+
+  is(min(), undef, 'no arg');
+  is($warning, undef, 'no args no warning');
+
+  is(min(undef), undef, 'undef arg');
+  like($warning, qr/Use of uninitialized value in subroutine entry/, 'undef arg warning');
+
+  is(min("a"), "a", 'non-numeric arg');
+  like($warning, qr/Argument "a" isn't numeric in subroutine entry/, 'non-numeric arg warning');
+
+  is(min(2, undef), undef, 'undef is smaller than 2');
+
+  is(min(-2, undef), -2, 'undef is larger than -2');
+}

t/minstr.t

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 5;
+use Test::More tests => 12;
 use List::Util qw(minstr);
 
 my $v;
@@ -23,3 +23,19 @@ my @a = map { pack("u", pack("C*",map { int(rand(256))} (0..int(rand(10) + 2))))
 my @b = sort { $a cmp $b } @a;
 $v = minstr(@a);
 is($v, $b[0], 'random ordered');
+
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
+
+  is(minstr(), undef, 'no arg');
+  is($warning, undef, 'no args no warning');
+
+  is(minstr(undef), undef, 'single undef arg');
+  is($warning, undef, 'no single undef arg warning'); # XXX
+
+  is(minstr(undef, undef), undef, 'two undef arg');
+  like($warning, qr/Use of uninitialized value in subroutine entry/, 'two undef arg warning');
+
+  is(minstr("a", undef), undef, 'undef is lt anything');
+}

t/product.t

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 25;
+use Test::More tests => 30;
 
 use Config;
 use List::Util qw(product);
@@ -125,3 +125,16 @@ SKIP: {
   cmp_ok($t, '>',  (1<<61), 'max*max*8'); # may be an NV
 
 }
+
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
+
+  is(product(undef), 0, 'undef arg');
+  like($warning, qr/Use of uninitialized value in subroutine entry/, 'undef arg warning');
+
+  is(product("a"), 0, 'non-numeric arg');
+  like($warning, qr/Argument "a" isn't numeric in subroutine entry/, 'non-numeric arg warning');
+
+  is(product(undef, 1), 0, 'undef is 0');
+}

t/prototype.t

@@ -4,7 +4,7 @@ use strict;
 use warnings;
 
 use Sub::Util qw( prototype set_prototype );
-use Test::More tests => 13;
+use Test::More tests => 17;
 
 sub f { }
 is( prototype('f'), undef, 'no prototype');
@@ -38,3 +38,16 @@ is( prototype('f_decl'), '$$$$', 'forward declaration');
 
 set_prototype('\%', \&f_decl);
 is( prototype('f_decl'), '\%', 'change forward declaration');
+
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
+
+  my @c = prototype();
+  is( scalar @c, 0, 'no arg results in empty list'); # XXX
+  like($warning, qr/Use of uninitialized value in subroutine prototype/, 'no arg results in undef arg warning');
+  undef $warning;
+
+  is( prototype(undef), undef, 'undef arg');
+  like($warning, qr/Use of uninitialized value in subroutine prototype/, 'undef arg warning');
+}

t/readonly.t

@@ -4,7 +4,7 @@ use strict;
 use warnings;
 
 use Scalar::Util qw(readonly);
-use Test::More tests => 11;
+use Test::More tests => 13;
 
 ok( readonly(1),	'number constant');
 
@@ -41,3 +41,11 @@ $var = 123;
     ok( try ("abc"), 'reference a constant in a sub');
 }
 ok( !try ($var), 'reference a non-constant in a sub');
+
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
+
+  ok(readonly(undef), 'undef is readonly');
+  is($warning, undef, 'no warning on undef');
+}

t/reftype.t

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 32;
+use Test::More tests => 34;
 
 use Scalar::Util qw(reftype);
 use vars qw(*F);
@@ -45,6 +45,14 @@ foreach my $test (@test) {
   is( reftype($what), $type, $n);
 }
 
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
+
+  is(reftype(undef), undef, 'undef arg');
+  is($warning, undef, 'no undef arg warning'); # XXX
+}
+
 package MyTie;
 
 sub TIEHANDLE { bless {} }

t/sum.t

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 17;
+use Test::More tests => 23;
 
 use Config;
 use List::Util qw(sum);
@@ -38,6 +38,20 @@ my $thr = Foo->new(3);
 $v = sum($one,$two,$thr);
 is($v, 6, 'overload');
 
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
+
+  is(sum(undef), 0, 'undef arg');
+  like($warning, qr/Use of uninitialized value in subroutine entry/, 'undef arg warning');
+
+  is(sum("a"), 0, 'non-numeric arg');
+  like($warning, qr/Argument "a" isn't numeric in subroutine entry/, 'non-numeric arg warning');
+
+  is(sum(2, undef), 2, 'undef gets forced to 0');
+
+  is(sum(2, "a"), 2, 'strings get forced to 0');
+}
 
 { package Foo;
 

t/sum0.t

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3;
+use Test::More tests => 9;
 
 use List::Util qw( sum0 );
 
@@ -15,3 +15,18 @@ is( $v, 9, 'one arg' );
 
 $v = sum0(1,2,3,4);
 is( $v, 10, '4 args');
+
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
+
+  is(sum0(undef), 0, 'undef arg');
+  like($warning, qr/Use of uninitialized value in subroutine entry/, 'undef arg warning');
+
+  is(sum0("a"), 0, 'non-numeric arg');
+  like($warning, qr/Argument "a" isn't numeric in subroutine entry/, 'non-numeric arg warning');
+
+  is(sum0(2, undef), 2, 'undef gets forced to 0');
+
+  is(sum0(2, "a"), 2, 'strings get forced to 0');
+}

t/tainted.t

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 5;
+use Test::More tests => 7;
 
 use Scalar::Util qw(tainted);
 
@@ -26,3 +26,11 @@ ok( tainted($var),	'copy of interpreter variable');
 
 tie my $tiedvar, 'Tainted';
 ok( tainted($tiedvar), 'for magic variables');
+
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
+
+  ok(!tainted(undef), 'undef is not tainted');
+  is($warning, undef, 'no undef arg warning');
+}

t/uniq.t

@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 30;
+use Test::More tests => 33;
 use List::Util qw( uniqnum uniqstr uniq );
 
 use Tie::Array;
@@ -211,3 +211,13 @@ is( scalar( uniqstr qw( a b c d a b e ) ), 5, 'uniqstr() in scalar context' );
         'uniq uniquifies mixed numbers and strings correctly in a tied array'
     );
 }
+
+{
+  my $warning;
+  local $SIG{__WARN__} = sub { $warning = shift };
+
+  my @set = uniqnum("a");
+  is(@set, 1, 'string arg');
+  is($set[0], "a", 'string arg');
+  is($warning, undef, 'no string arg warning'); # XXX
+}