r62093 - in /branches/upstream/libscalar-util-numeric-perl/current: Changes MANIFEST MANIFEST.SKIP META.yml Makefile.PL Numeric.xs README lib/Scalar/Util/Numeric.pm t/all.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Fri Aug 27 23:48:04 UTC 2010
Author: gregoa
Date: Fri Aug 27 23:47:58 2010
New Revision: 62093
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=62093
Log:
[svn-upgrade] new version libscalar-util-numeric-perl (0.22)
Added:
branches/upstream/libscalar-util-numeric-perl/current/MANIFEST.SKIP
Modified:
branches/upstream/libscalar-util-numeric-perl/current/Changes
branches/upstream/libscalar-util-numeric-perl/current/MANIFEST
branches/upstream/libscalar-util-numeric-perl/current/META.yml
branches/upstream/libscalar-util-numeric-perl/current/Makefile.PL
branches/upstream/libscalar-util-numeric-perl/current/Numeric.xs
branches/upstream/libscalar-util-numeric-perl/current/README
branches/upstream/libscalar-util-numeric-perl/current/lib/Scalar/Util/Numeric.pm
branches/upstream/libscalar-util-numeric-perl/current/t/all.t
Modified: branches/upstream/libscalar-util-numeric-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libscalar-util-numeric-perl/current/Changes?rev=62093&op=diff
==============================================================================
--- branches/upstream/libscalar-util-numeric-perl/current/Changes (original)
+++ branches/upstream/libscalar-util-numeric-perl/current/Changes Fri Aug 27 23:47:58 2010
@@ -1,4 +1,19 @@
Revision history for Perl extension Scalar::Util::Numeric.
+
+0.22 Wed Aug 25 11:45:18 2010
+ - Windows: don't call grok_number if we already know it isn't
+ - XS cleanup
+ - more tests
+
+0.21 Wed Aug 25 02:53:53 2010
+ - call grok_number directly rather than the redundant looks_like_number wrapper
+
+0.20 Tue Aug 24 22:56:36 2010
+ - try to fix Inf and NaN on Windows
+ - handle overloaded objects
+
+0.11 Mon Aug 23 17:52:30 2010
+ - only show diagnostics for failing tests
0.10 Sat Aug 21 14:16:07 2010
- bump min perl version to 5.8.0
Modified: branches/upstream/libscalar-util-numeric-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libscalar-util-numeric-perl/current/MANIFEST?rev=62093&op=diff
==============================================================================
--- branches/upstream/libscalar-util-numeric-perl/current/MANIFEST (original)
+++ branches/upstream/libscalar-util-numeric-perl/current/MANIFEST Fri Aug 27 23:47:58 2010
@@ -2,6 +2,7 @@
lib/Scalar/Util/Numeric.pm
Makefile.PL
MANIFEST This list of files
+MANIFEST.SKIP
META.yml
Numeric.xs
ppport.h
Added: branches/upstream/libscalar-util-numeric-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libscalar-util-numeric-perl/current/MANIFEST.SKIP?rev=62093&op=file
==============================================================================
--- branches/upstream/libscalar-util-numeric-perl/current/MANIFEST.SKIP (added)
+++ branches/upstream/libscalar-util-numeric-perl/current/MANIFEST.SKIP Fri Aug 27 23:47:58 2010
@@ -1,0 +1,34 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+\bSCCS\b
+,v$
+\B\.svn\b
+\B\.git\b
+\B\.gitignore\b
+\b_darcs\b
+
+# Avoid Makemaker generated and utility files.
+\bMANIFEST\.bak
+\bMakefile$
+\bblib/
+\bMakeMaker-\d
+\bpm_to_blib\.ts$
+\bpm_to_blib$
+\bblibdirs\.ts$ # 6.18 through 6.25 generated this
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build/
+
+# Avoid temp and backup files.
+~$
+\.old$
+\#$
+\b\.#
+\.bak$
+
+# Avoid Devel::Cover files.
+\bcover_db\b
+
+^dev/
Modified: branches/upstream/libscalar-util-numeric-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libscalar-util-numeric-perl/current/META.yml?rev=62093&op=diff
==============================================================================
--- branches/upstream/libscalar-util-numeric-perl/current/META.yml (original)
+++ branches/upstream/libscalar-util-numeric-perl/current/META.yml Fri Aug 27 23:47:58 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Scalar-Util-Numeric
-version: 0.10
+version: 0.22
abstract: numeric tests for Perl scalars
author:
- chocolateboy <chocolate at cpan.org>, Michael G Schwern <schwern at pobox.com>
@@ -10,10 +10,9 @@
ExtUtils::MakeMaker: 0
build_requires:
ExtUtils::MakeMaker: 0
-requires:
- Test::More: 0
+requires: {}
resources:
- repository: http://github.com/schwern/Scalar-Util-Numeric
+ repository: http://github.com/chocolateboy/Scalar-Util-Numeric
no_index:
directory:
- t
Modified: branches/upstream/libscalar-util-numeric-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libscalar-util-numeric-perl/current/Makefile.PL?rev=62093&op=diff
==============================================================================
--- branches/upstream/libscalar-util-numeric-perl/current/Makefile.PL (original)
+++ branches/upstream/libscalar-util-numeric-perl/current/Makefile.PL Fri Aug 27 23:47:58 2010
@@ -10,7 +10,8 @@
if ($Config{gccversion}) {
$OPTIMIZE = '-O3 -Wall -W';
- $OPTIMIZE .= ' -g -Wextra -Wdeclaration-after-statement' if (-d 'dev');
+ # the dev directory is under VC now - look for a hidden file instead
+ $OPTIMIZE .= ' -g -Wextra -Wdeclaration-after-statement' if (-f '.dev');
} elsif ($Config{osname} eq 'MSWin32') {
$OPTIMIZE = '-O2 -W4';
} else {
@@ -18,11 +19,9 @@
}
WriteMakefile(
- NAME => 'Scalar::Util::Numeric',
- VERSION_FROM => 'lib/Scalar/Util/Numeric.pm',
- PREREQ_PM => {
- 'Test::More' => 0,
- },
+ NAME => 'Scalar::Util::Numeric',
+ VERSION_FROM => 'lib/Scalar/Util/Numeric.pm',
+ PREREQ_PM => {},
ABSTRACT_FROM => 'lib/Scalar/Util/Numeric.pm',
AUTHOR => 'chocolateboy <chocolate at cpan.org>, Michael G Schwern <schwern at pobox.com>',
LIBS => [ '' ],
@@ -33,7 +32,7 @@
($ExtUtils::MakeMaker::VERSION >= 6.46 ?
(META_MERGE => {
resources => {
- repository => 'http://github.com/schwern/Scalar-Util-Numeric',
+ repository => 'http://github.com/chocolateboy/Scalar-Util-Numeric',
},
})
: ()
Modified: branches/upstream/libscalar-util-numeric-perl/current/Numeric.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libscalar-util-numeric-perl/current/Numeric.xs?rev=62093&op=diff
==============================================================================
--- branches/upstream/libscalar-util-numeric-perl/current/Numeric.xs (original)
+++ branches/upstream/libscalar-util-numeric-perl/current/Numeric.xs Fri Aug 27 23:47:58 2010
@@ -4,20 +4,103 @@
#include "XSUB.h"
#include "ppport.h"
-I32 is_num(pTHX_ SV * const sv);
-I32 is_num(pTHX_ SV * const sv) {
+STATIC I32 is_num(pTHX_ SV * sv);
+STATIC I32 is_num(pTHX_ SV * sv) {
I32 type = 0;
- if (!(SvROK(sv) || (sv == (SV *)&PL_sv_undef))) {
- /* stringify - ironically, looks_like_number always returns 1 unless arg is a string */
+ if (sv && (sv != &PL_sv_undef)) {
+ STRLEN len;
+ const char * str = NULL;
if (SvPOK(sv)) {
- type = looks_like_number(sv);
- } else {
- STRLEN len;
- const char * const str = SvPV(sv, len);
- type = looks_like_number(sv_2mortal(newSVpv(str, len)));
+ str = SvPVX_const(sv);
+ len = SvCUR(sv);
+ } else { /* stringify numbers, references and overloaded objects */
+ str = SvPV_const(sv, len);
}
+
+/*
+ * handle 1.#INF (Inf), -1.#INF (-Inf), and 1.#IND (NaN) on Windows:
+ * http://www.johndcook.com/IEEE_exceptions_in_cpp.html
+ *
+ * switch trie generated by Devel::Tokenizer::C (Marcus Holland-Moritz++)
+ * hacked about to make the formatting less annoying :-)
+ */
+
+#ifdef WIN32
+ switch (len) {
+ case 6: /* 2 tokens of length 6 */
+ switch (str[5]) {
+ case 'D':
+ if (str[0] == '1' &&
+ str[1] == '.' &&
+ str[2] == '#' &&
+ str[3] == 'I' &&
+ str[4] == 'N')
+ { /* 1.#IND */
+ return IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
+ }
+
+ goto fail_early;
+
+ case 'F':
+ if (str[0] == '1' &&
+ str[1] == '.' &&
+ str[2] == '#' &&
+ str[3] == 'I' &&
+ str[4] == 'N')
+ { /* 1.#INF */
+ return IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
+ }
+
+ goto fail_early;
+
+ default:
+ goto not_nan_or_inf;
+ }
+
+ case 7: /* 2 tokens of length 7 */
+ switch (str[6]) {
+ case 'D':
+ if (str[0] == '-' &&
+ str[1] == '1' &&
+ str[2] == '.' &&
+ str[3] == '#' &&
+ str[4] == 'I' &&
+ str[5] == 'N')
+ { /* -1.#IND */
+ return IS_NUMBER_NEG | IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
+ }
+
+ goto fail_early;
+
+ case 'F':
+ if (str[0] == '-' &&
+ str[1] == '1' &&
+ str[2] == '.' &&
+ str[3] == '#' &&
+ str[4] == 'I' &&
+ str[5] == 'N')
+ { /* -1.#INF */
+ return IS_NUMBER_NEG | IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
+ }
+
+ goto fail_early;
+
+ default:
+ goto not_nan_or_inf;
+ }
+
+ default:
+ goto not_nan_or_inf;
+ }
+
+ fail_early:
+ return 0;
+
+ not_nan_or_inf:
+#endif
+ type = grok_number(str, len, NULL);
}
return type;
@@ -32,14 +115,14 @@
XSRETURN_UV(UV_MAX);
void
-isnum (sv)
+isnum(sv)
SV * sv
PROTOTYPE: $
CODE:
XSRETURN_IV(is_num(aTHX_ sv));
void
-isint (sv)
+isint(sv)
SV * sv
PROTOTYPE: $
CODE:
@@ -57,42 +140,42 @@
XSRETURN_IV(ret);
void
-isuv (sv)
+isuv(sv)
SV * sv
PROTOTYPE: $
CODE:
XSRETURN_IV((is_num(aTHX_ sv) & 1) ? 1 : 0);
void
-isbig (sv)
+isbig(sv)
SV * sv
PROTOTYPE: $
CODE:
XSRETURN_IV((is_num(aTHX_ sv) & 2) ? 1 : 0);
void
-isfloat (sv)
+isfloat(sv)
SV * sv
PROTOTYPE: $
CODE:
XSRETURN_IV((is_num(aTHX_ sv) & 4) ? 1 : 0);
void
-isneg (sv)
+isneg(sv)
SV * sv
PROTOTYPE: $
CODE:
XSRETURN_IV((is_num(aTHX_ sv) & 8) ? 1 : 0);
void
-isinf (sv)
+isinf(sv)
SV * sv
PROTOTYPE: $
CODE:
XSRETURN_IV((is_num(aTHX_ sv) & 16) ? 1 : 0);
void
-isnan (sv)
+isnan(sv)
SV * sv
PROTOTYPE: $
CODE:
Modified: branches/upstream/libscalar-util-numeric-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libscalar-util-numeric-perl/current/README?rev=62093&op=diff
==============================================================================
--- branches/upstream/libscalar-util-numeric-perl/current/README (original)
+++ branches/upstream/libscalar-util-numeric-perl/current/README Fri Aug 27 23:47:58 2010
@@ -1,4 +1,4 @@
-Scalar-Util-Numeric version 0.10
+Scalar-Util-Numeric version 0.22
================================
This module exports a number of wrappers around perl's builtin looks_like_number function, which
Modified: branches/upstream/libscalar-util-numeric-perl/current/lib/Scalar/Util/Numeric.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libscalar-util-numeric-perl/current/lib/Scalar/Util/Numeric.pm?rev=62093&op=diff
==============================================================================
--- branches/upstream/libscalar-util-numeric-perl/current/lib/Scalar/Util/Numeric.pm (original)
+++ branches/upstream/libscalar-util-numeric-perl/current/lib/Scalar/Util/Numeric.pm Fri Aug 27 23:47:58 2010
@@ -8,7 +8,7 @@
use base qw(Exporter);
use XSLoader;
-our $VERSION = '0.10';
+our $VERSION = '0.22';
our %EXPORT_TAGS = (
'all' => [ qw(isbig isfloat isinf isint isnan isneg isnum isuv) ],
@@ -40,7 +40,7 @@
=head1 DESCRIPTION
-This module exports a number of wrappers around perl's builtin C<looks_like_number> function, which
+This module exports a number of wrappers around perl's builtin C<grok_number> function, which
returns the numeric type of its argument, or 0 if it isn't numeric.
=head1 TAGS
@@ -65,6 +65,20 @@
0x08 IS_NUMBER_NEG (leading minus sign)
0x10 IS_NUMBER_INFINITY (Infinity)
0x20 IS_NUMBER_NAN (NaN - not a number)
+
+=head2 isint
+
+=head2 isuv
+
+=head2 isbig
+
+=head2 isfloat
+
+=head2 isneg
+
+=head2 isinf
+
+=head2 isnan
The following flavours of C<isnum> (corresponding to the flags above) are also available:
@@ -99,6 +113,10 @@
=back
+=head1 VERSION
+
+0.22
+
=head1 AUTHORS
=over
Modified: branches/upstream/libscalar-util-numeric-perl/current/t/all.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libscalar-util-numeric-perl/current/t/all.t?rev=62093&op=diff
==============================================================================
--- branches/upstream/libscalar-util-numeric-perl/current/t/all.t (original)
+++ branches/upstream/libscalar-util-numeric-perl/current/t/all.t Fri Aug 27 23:47:58 2010
@@ -6,62 +6,149 @@
use Config;
use Math::BigInt;
use Math::Complex;
-use Test::More tests => 34;
+use Test::More tests => 86;
+
+use overload
+ '""' => sub { '' . $_[0]->[0] },
+ '0+' => sub { $_[0]->[0] },
+ fallback => 1;
+
+sub new {
+ my $class = shift;
+ bless [ @_ ], $class;
+}
+
+# only debug the value if one or more of its tests fails
+sub diag_if_fail($@) {
+ my $diag = shift;
+ my $fail = 0;
+
+ for my $test (@_) {
+ ++$fail unless ($test->());
+ }
+
+ if ($fail) {
+ $diag = [ $diag ] unless (ref $diag);
+ diag $_ for @$diag;
+ }
+}
use_ok('Scalar::Util::Numeric', qw(:all));
+# test overloading
+my $integer = __PACKAGE__->new(42);
+ok($integer, '$integer is set');
+ok($integer == $integer, '$integer == $integer');
+ok($integer == 42, '$integer == 42');
+isa_ok($integer, __PACKAGE__);
+
+my $float = __PACKAGE__->new(3.1415927);
+ok($float, '$float is set');
+ok($float == $float, '$float == $float');
+ok($float == 3.1415927, '$float == 3.1415927');
+isa_ok($float, __PACKAGE__);
+
my $uvmax = Scalar::Util::Numeric::uvmax();
+ok(defined($uvmax), 'uvmax is defined');
+
my $uvmax_plus_one = Math::BigInt->new($uvmax)->badd(1)->bstr();
+
+ok(defined($uvmax_plus_one), 'uvmax + 1 is defined');
my $infinity = do {
no warnings 'once';
$Math::Complex::Inf;
};
-is (isnum(0), 1, 'isnum(0) == 1');
-is (isnum(1), 1, 'isnum(1) == 1');
-is (isnum(-1), 9, 'isnum(-1) == 9');
-is (isnum('0.00'), 5, "isnum('0.00') == 5");
-is (isnum(undef), 0, "isnum(undef) == 0");
-is (isnum('A'), 0, "isnum('A') == 0");
-is (isnum('A0'), 0, "isnum('A0') == 0");
-is (isnum('0A'), 0, "isnum('0A') == 0");
-is (isnum(\&ok), 0, "isnum(\\&ok) == 0");
+ok(defined($infinity), 'infinity is defined');
-diag "$/UV_MAX: <<$uvmax>>";
-is (isuv($uvmax), 1, 'isuv($uvmax) == 1');
-is (isuv(-1), 1, "isuv(-1) == 1");
+is (isnum(0), 1, 'isnum(0)');
+is (isnum(1), 1, 'isnum(1)');
+is (isnum(-1), 9, 'isnum(-1)');
+is (isnum('0.00'), 5, "isnum('0.00')");
+is (isnum(undef), 0, "isnum(undef)");
+is (isnum('A'), 0, "isnum('A')");
+is (isnum('A0'), 0, "isnum('A0')");
+is (isnum('0A'), 0, "isnum('0A')");
+is (isnum(sub { }), 0, "isnum(sub { })");
+is (isnum([]), 0, 'isnum([])');
+is (isnum({}), 0, 'isnum({})');
+is (isnum($integer), 1, "isnum(\$integer)");
+is (isnum($float), 5, "isnum(\$float)");
-diag "UV_MAX + 1: <<$uvmax_plus_one>>";
-is (isbig($uvmax), 0, "isbig(\$uvmax) == 0");
-is (isbig($uvmax_plus_one), 1, "isbig(\$uvmax + 1) == 1");
+diag_if_fail "UV_MAX: '$uvmax'" =>
+ sub { is (isuv($uvmax), 1, 'isuv($uvmax)') },
+ sub { is (isuv(-1), 1, "isuv(-1)") };
-is (isfloat(3.1415927), 1, "isfloat(3.1415927) == 1");
-is (isfloat(-3.1415927), 1, "isfloat(-3.1415927) == 1");
-is (isfloat(3), 0, "isfloat(3) == 0");
+diag_if_fail [ "UV_MAX: '$uvmax'", "UV_MAX + 1: '$uvmax_plus_one'" ] =>
+ sub { is (isbig($uvmax), 0, "isbig(\$uvmax)") },
+ sub { is (isbig($uvmax_plus_one), 1, "isbig(\$uvmax + 1)") };
+
+is (isfloat(3.1415927), 1, "isfloat(3.1415927)");
+is (isfloat(-3.1415927), 1, "isfloat(-3.1415927)");
+is (isfloat(3), 0, "isfloat(3)");
is (isfloat("1.0"), 1, "isfloat('1.0')");
+is (isfloat($float), 1, "isfloat(\$float)");
-is (isneg(-1), 1, "isneg(-1) == 1");
-is (isneg(-3.1415927), 1, "isneg(-3.1415927) == 1");
-is (isneg(1), 0, "isneg(1) == 0");
-is (isneg(3.1415927), 0, "isneg(3.1415927) == 0");
+is (isneg(-1), 1, "isneg(-1)");
+is (isneg(-3.1415927), 1, "isneg(-3.1415927)");
+is (isneg(1), 0, "isneg(1)");
+is (isneg(3.1415927), 0, "isneg(3.1415927)");
-diag "INFINITY: <<$infinity>>";
-is (isinf('Inf'), 1, "isinf('Inf') == 1");
-is (isinf(3.1415927), 0, "isinf(3.1415927) == 0");
-is (isinf($infinity), 1, 'isinf($Math::Complex::Inf) == 1');
+diag_if_fail "INFINITY: '$infinity'" =>
+ sub { is (isinf('Inf'), 1, "isinf('Inf')") },
+ sub { is (isinf(3.1415927), 0, "isinf(3.1415927)") },
+ sub { is (isinf($infinity), 1, 'isinf($Math::Complex::Inf)') };
is (isint(-99), -1, "isint(-99) == -1");
-is (isint(0), 1, "isint(0) == 1");
-is (isint(3.1415927), 0, "isint(3.1415927) == 0");
-is (isint(-3.1415927), 0, "isint(-3.1415927) == 0");
-is (isint($uvmax), 1, 'isint($uvmax) == 1');
-is (isint($infinity), 0, 'isint($Math::Complex::Inf) == 0');
+is (isint(0), 1, "isint(0)");
+is (isint(3.1415927), 0, "isint(3.1415927)");
+is (isint(-3.1415927), 0, "isint(-3.1415927)");
+is (isint($uvmax), 1, 'isint($uvmax)');
+is (isint($infinity), 0, 'isint($Math::Complex::Inf)');
is (isint("1.0"), 0, "isint('1.0')");
+is (isint($integer), 1, "isint(\$integer)");
+is (isint($float), 0, "isint(\$float)");
SKIP: {
skip ('NaN is not supported by this platform', 2) unless($Config{d_isnan});
- is (isnan('NaN'), 1, "isnan('NaN') == 1");
- is (isnan(42), 0, "isnan(42) == 0");
+
+ # this also tests handling of objects with overloaded stringification
+ my $nan = Math::BigInt->bnan;
+
+ diag_if_fail "NAN: '$nan'" =>
+ sub { is (isnan('NaN'), 1, "isnan('NaN')") },
+ sub { is (isnan(42), 0, "isnan(42)") };
}
+
+# test the assumed Inf/NaN values on Windows
+SKIP: {
+ skip ('Windows only', 10) unless($^O eq 'MSWin32');
+
+ my $infinity = '1.#INF';
+
+ diag_if_fail "INFINITY: '$infinity'" =>
+ sub { is (isinf($infinity), 1, "isinf('$infinity')") },
+ sub { is (isinf("-$infinity"), 1, "isinf('-$infinity')") },
+ sub { is (isinf(3.1415927), 0, "isinf(3.1415927)") },
+ sub { is (isinf(42), 0, "isinf(42)") },
+ sub { is (isint($infinity), 0, "isint('$infinity')") },
+ sub { is (isint("-$infinity"), 0, "isint('-$infinity')") };
+
+ my $nan = '1.#IND';
+
+ diag_if_fail "NaN: '$nan'" =>
+ sub { is (isnan($nan), 1, "isnan('$nan')") },
+ sub { is (isnan("-$nan"), 1, "isnan('-$nan')") },
+ sub { is (isnan(3.1415927), 0, "isnan(3.1415927)") },
+ sub { is (isnan(42), 0, "isnan(42)") };
+}
+
+# throw in some near-misses (wrong spelling and wrong case) for the Win32 Inf and NaN
+# these should be invalid numbers on all platforms
+for my $fail ('1.#IMD', '-1.#IMD', '1.#IMF', '-1.#IMF', '1.#InD', '-1.#InD', '1.#InF', '-1.#InF') {
+ is(isint($fail), 0);
+ is(isinf($fail), 0);
+ is(isnan($fail), 0);
+}
More information about the Pkg-perl-cvs-commits
mailing list