r34948 - in /trunk/libscalar-number-perl: ./ debian/ lib/Scalar/ t/
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Fri May 8 07:04:06 UTC 2009
Author: ryan52-guest
Date: Fri May 8 07:04:00 2009
New Revision: 34948
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=34948
Log:
* New upstream release
* Add myself to Uploaders
* Debian Policy 3.8.1
Added:
trunk/libscalar-number-perl/Build.PL
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/Build.PL
trunk/libscalar-number-perl/SIGNATURE
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/SIGNATURE
trunk/libscalar-number-perl/lib/Scalar/.cvsignore
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/lib/Scalar/.cvsignore
trunk/libscalar-number-perl/lib/Scalar/Number.xs
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/lib/Scalar/Number.xs
trunk/libscalar-number-perl/t/class.t
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/t/class.t
trunk/libscalar-number-perl/t/class_pp.t
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/t/class_pp.t
trunk/libscalar-number-perl/t/id_cmp_pp.t
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/t/id_cmp_pp.t
trunk/libscalar-number-perl/t/num_forms.pl
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/t/num_forms.pl
trunk/libscalar-number-perl/t/part_pp.t
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/t/part_pp.t
trunk/libscalar-number-perl/t/pod_cvg.t
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/t/pod_cvg.t
trunk/libscalar-number-perl/t/pod_syn.t
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/t/pod_syn.t
trunk/libscalar-number-perl/t/setup_pp.pl
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/t/setup_pp.pl
trunk/libscalar-number-perl/t/val_cmp.at
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/t/val_cmp.at
trunk/libscalar-number-perl/t/val_cmp_pp.at
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/t/val_cmp_pp.at
trunk/libscalar-number-perl/t/values.data
- copied unchanged from r34947, branches/upstream/libscalar-number-perl/current/t/values.data
Removed:
trunk/libscalar-number-perl/t/class_all.t
trunk/libscalar-number-perl/t/class_i32_f52.t
trunk/libscalar-number-perl/t/class_i64_f52.t
trunk/libscalar-number-perl/t/val_cmp_all.t
trunk/libscalar-number-perl/t/val_cmp_i32_f52.t
trunk/libscalar-number-perl/t/val_cmp_i64_f52.t
Modified:
trunk/libscalar-number-perl/.cvsignore
trunk/libscalar-number-perl/Changes
trunk/libscalar-number-perl/MANIFEST
trunk/libscalar-number-perl/META.yml
trunk/libscalar-number-perl/Makefile.PL
trunk/libscalar-number-perl/README
trunk/libscalar-number-perl/debian/changelog
trunk/libscalar-number-perl/debian/control
trunk/libscalar-number-perl/lib/Scalar/Number.pm
trunk/libscalar-number-perl/t/id_cmp.t
trunk/libscalar-number-perl/t/part.t
Modified: trunk/libscalar-number-perl/.cvsignore
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscalar-number-perl/.cvsignore?rev=34948&op=diff
==============================================================================
--- trunk/libscalar-number-perl/.cvsignore (original)
+++ trunk/libscalar-number-perl/.cvsignore Fri May 8 07:04:00 2009
@@ -1,4 +1,4 @@
-Makefile Makefile.old
-blib pm_to_blib
-META.yml
+Build Makefile
+_build blib
+META.yml Makefile.PL SIGNATURE
Scalar-Number-*
Modified: trunk/libscalar-number-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscalar-number-perl/Changes?rev=34948&op=diff
==============================================================================
--- trunk/libscalar-number-perl/Changes (original)
+++ trunk/libscalar-number-perl/Changes Fri May 8 07:04:00 2009
@@ -1,3 +1,60 @@
+version 0.004; 2009-05-02
+
+ * load some modules at build time instead of configure time, to avoid
+ dependency problems
+
+version 0.003; 2009-04-29
+
+ * bugfix: when loading pure Perl implementation, check for numeric
+ semantics that make it impossible to operate correctly (perl 5.6
+ with integers longer than floats), and refuse to load if the module
+ won't work right
+
+ * bugfix: in sclnum_val_cmp(), work around perl bug #41202 which
+ caused some comparisons on values originating as strings to yield
+ the wrong answers
+
+ * bugfix: in scalar_num_part(), handle numeric conversions of non-number
+ types correctly
+
+ * bugfix: require bugfixed version of Data::Integer (it gave incorrect
+ constants on perl 5.6)
+
+ * bugfix: require bugfixed version of Data::Float (for $SIG{__DIE__}
+ handling)
+
+ * XS implementation, used if available with fallback to existing pure
+ Perl implementation if XS is not available; the XS implementation
+ works on Perl 5.6 with wide integers
+
+ * test classification and comparison functions with values that are
+ internally expressed in each possible way
+
+ * test classification and value comparison functions with a set of
+ test values that adapts to the format widths encountered, rather
+ than using separate test scripts for each combination of format widths
+
+ * change very lengthy value comparison test function to not run as
+ part of the default test suite
+
+ * document that sclnum_*() functions must be given only numeric
+ arguments
+
+ * use simpler "parent" pragma in place of "base"
+
+ * in documentation, use the term "truth value" instead of the less
+ precise "boolean"
+
+ * test POD syntax and coverage
+
+ * build with Module::Build instead of ExtUtils::MakeMaker
+
+ * complete dependency list
+
+ * include signature in distribution
+
+ * in documentation, separate "license" section from "copyright" section
+
version 0.002; 2007-09-02
* in tests, catch exceptions from sprintf("%.1f", $_), to work around a
Modified: trunk/libscalar-number-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscalar-number-perl/MANIFEST?rev=34948&op=diff
==============================================================================
--- trunk/libscalar-number-perl/MANIFEST (original)
+++ trunk/libscalar-number-perl/MANIFEST Fri May 8 07:04:00 2009
@@ -1,15 +1,24 @@
.cvsignore
+Build.PL
Changes
MANIFEST
META.yml
Makefile.PL
README
+lib/Scalar/.cvsignore
lib/Scalar/Number.pm
-t/class_all.t
-t/class_i32_f52.t
-t/class_i64_f52.t
+lib/Scalar/Number.xs
+t/class.t
+t/class_pp.t
t/id_cmp.t
+t/id_cmp_pp.t
+t/num_forms.pl
t/part.t
-t/val_cmp_all.t
-t/val_cmp_i32_f52.t
-t/val_cmp_i64_f52.t
+t/part_pp.t
+t/pod_cvg.t
+t/pod_syn.t
+t/setup_pp.pl
+t/values.data
+t/val_cmp.at
+t/val_cmp_pp.at
+SIGNATURE Added here by Module::Build
Modified: trunk/libscalar-number-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscalar-number-perl/META.yml?rev=34948&op=diff
==============================================================================
--- trunk/libscalar-number-perl/META.yml (original)
+++ trunk/libscalar-number-perl/META.yml Fri May 8 07:04:00 2009
@@ -1,12 +1,40 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Scalar-Number
-version: 0.002
-version_from: lib/Scalar/Number.pm
-installdirs: site
+---
+name: Scalar-Number
+version: 0.004
+author:
+ - 'Andrew Main (Zefram) <zefram at fysh.org>'
+abstract: numeric aspects of scalars
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
requires:
- Data::Float: 0.005
- Data::Integer: 0.000
-
+ Carp: 0
+ Data::Float: 0.008
+ Data::Integer: 0.003
+ Exporter: 0
+ constant: 0
+ overload: 0
+ parent: 0
+ perl: 5.006
+ strict: 0
+ warnings: 0
+build_requires:
+ Data::Float: 0.008
+ Data::Integer: 0.003
+ Module::Build: 0
+ Test::More: 0
+ perl: 5.006
+ strict: 0
+ warnings: 0
+recommends:
+ XSLoader: 0
+dynamic_config: 1
+provides:
+ Scalar::Number:
+ file: lib/Scalar/Number.pm
+ version: 0.004
+generated_by: Module::Build version 0.31012
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30_01
Modified: trunk/libscalar-number-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscalar-number-perl/Makefile.PL?rev=34948&op=diff
==============================================================================
--- trunk/libscalar-number-perl/Makefile.PL (original)
+++ trunk/libscalar-number-perl/Makefile.PL Fri May 8 07:04:00 2009
@@ -1,10 +1,32 @@
-use ExtUtils::MakeMaker;
-
-WriteMakefile(
- NAME => "Scalar::Number",
- VERSION_FROM => "lib/Scalar/Number.pm",
- PREREQ_PM => {
- Data::Float => "0.005",
- Data::Integer => "0.000",
- },
-);
+# Note: this file was auto-generated by Module::Build::Compat version 0.31012
+require 5.006;
+
+ unless (eval "use Module::Build::Compat 0.02; 1" ) {
+ print "This module requires Module::Build to install itself.\n";
+
+ require ExtUtils::MakeMaker;
+ my $yn = ExtUtils::MakeMaker::prompt
+ (' Install Module::Build now from CPAN?', 'y');
+
+ unless ($yn =~ /^y/i) {
+ die " *** Cannot install without Module::Build. Exiting ...\n";
+ }
+
+ require Cwd;
+ require File::Spec;
+ require CPAN;
+
+ # Save this 'cause CPAN will chdir all over the place.
+ my $cwd = Cwd::cwd();
+
+ CPAN::Shell->install('Module::Build::Compat');
+ CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
+ or die "Couldn't install Module::Build, giving up.\n";
+
+ chdir $cwd or die "Cannot chdir() back to $cwd: $!";
+ }
+ eval "use Module::Build::Compat 0.02; 1" or die $@;
+ use lib '_build/lib';
+ Module::Build::Compat->run_build_pl(args => \@ARGV);
+ require MyModuleBuilder;
+ Module::Build::Compat->write_makefile(build_class => 'MyModuleBuilder');
Modified: trunk/libscalar-number-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscalar-number-perl/README?rev=34948&op=diff
==============================================================================
--- trunk/libscalar-number-perl/README (original)
+++ trunk/libscalar-number-perl/README Fri May 8 07:04:00 2009
@@ -16,12 +16,15 @@
classify a number by expressibility, and compare numbers across
representations.
+This module is implemented in XS, with a pure Perl backup version for
+systems that can't handle XS.
+
INSTALLATION
- perl Makefile.PL
- make
- make test
- make install
+ perl Build.PL
+ ./Build
+ ./Build test
+ ./Build install
AUTHOR
@@ -29,7 +32,9 @@
COPYRIGHT
-Copyright (C) 2007 Andrew Main (Zefram) <zefram at fysh.org>
+Copyright (C) 2007, 2009 Andrew Main (Zefram) <zefram at fysh.org>
+
+LICENSE
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Modified: trunk/libscalar-number-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscalar-number-perl/debian/changelog?rev=34948&op=diff
==============================================================================
--- trunk/libscalar-number-perl/debian/changelog (original)
+++ trunk/libscalar-number-perl/debian/changelog Fri May 8 07:04:00 2009
@@ -1,4 +1,4 @@
-libscalar-number-perl (0.002-3) UNRELEASED; urgency=low
+libscalar-number-perl (0.004-1) UNRELEASED; urgency=low
[ gregor herrmann ]
* debian/control: Changed: Switched Vcs-Browser field to ViewSVN
@@ -7,7 +7,12 @@
[ Rene Mayorga ]
* debian/control: update my email address.
- -- Rene Mayorga <rmayorga at debian.org> Tue, 20 Jan 2009 01:28:51 -0600
+ [ Ryan Niebur ]
+ * New upstream release
+ * Add myself to Uploaders
+ * Debian Policy 3.8.1
+
+ -- Ryan Niebur <ryanryan52 at gmail.com> Fri, 08 May 2009 00:03:50 -0700
libscalar-number-perl (0.002-2) unstable; urgency=low
Modified: trunk/libscalar-number-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscalar-number-perl/debian/control?rev=34948&op=diff
==============================================================================
--- trunk/libscalar-number-perl/debian/control (original)
+++ trunk/libscalar-number-perl/debian/control Fri May 8 07:04:00 2009
@@ -5,8 +5,9 @@
Build-Depends-Indep: perl (>= 5.8.8-7), libdata-float-perl (>= 0.005), libdata-integer-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: gregor herrmann <gregor+debian at comodo.priv.at>,
- Damyan Ivanov <dmn at debian.org>, Rene Mayorga <rmayorga at debian.org>
-Standards-Version: 3.7.3
+ Damyan Ivanov <dmn at debian.org>, Rene Mayorga <rmayorga at debian.org>,
+ Ryan Niebur <ryanryan52 at gmail.com>
+Standards-Version: 3.8.1
Homepage: http://search.cpan.org/dist/Scalar-Number/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libscalar-number-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libscalar-number-perl/
Modified: trunk/libscalar-number-perl/lib/Scalar/Number.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscalar-number-perl/lib/Scalar/Number.pm?rev=34948&op=diff
==============================================================================
--- trunk/libscalar-number-perl/lib/Scalar/Number.pm (original)
+++ trunk/libscalar-number-perl/lib/Scalar/Number.pm Fri May 8 07:04:00 2009
@@ -32,6 +32,9 @@
classify a number by expressibility, and compare numbers across
representations.
+This module is implemented in XS, with a pure Perl backup version for
+systems that can't handle XS.
+
=cut
package Scalar::Number;
@@ -39,21 +42,74 @@
use warnings;
use strict;
-use Carp qw(croak);
-use Data::Float 0.004 qw(
- have_signed_zero significand_bits max_integer
- float_is_infinite pow2 mult_pow2
-);
-use Data::Integer 0.000 qw(natint_bits min_natint max_natint);
-
-our $VERSION = "0.002";
-
-use base "Exporter";
+our $VERSION = "0.004";
+
+use parent "Exporter";
our @EXPORT_OK = qw(
scalar_num_part
sclnum_is_natint sclnum_is_float
sclnum_val_cmp sclnum_id_cmp
);
+
+eval { local $SIG{__DIE__};
+ require XSLoader;
+ XSLoader::load(__PACKAGE__, $VERSION);
+};
+
+if($@ eq "") {
+ close(DATA);
+ *scalar_num_part = sub($) {
+ no warnings qw(numeric uninitialized);
+ return _warnable_scalar_num_part($_[0]);
+ };
+} else {
+ local $/ = undef;
+ my $pp_code = <DATA>;
+ close(DATA);
+ {
+ local $SIG{__DIE__};
+ eval $pp_code;
+ }
+ die $@ if $@ ne "";
+}
+
+1;
+
+__DATA__
+
+use Carp qw(croak);
+use Data::Float 0.008 qw(
+ have_signed_zero significand_bits max_integer
+ float_is_infinite pow2 mult_pow2
+);
+use Data::Integer 0.003 qw(natint_bits min_natint max_natint hex_natint);
+use overload ();
+
+BEGIN {
+ # In perl 5.6, arithmetic is performed in floating point by default,
+ # even if the arguments are native integers that lose precision upon
+ # conversion to float. If there are such native integers then these
+ # semantics make it impossible in some cases to tell the difference
+ # between an integer and a nearby floating point value. Specifically,
+ # the maximum integer and its float approximation (which has a
+ # numeric value 1 higher) are indistinguishable. In that case, this
+ # module cannot be implemented in pure Perl. Detect that here by
+ # max_natint-2 appearing to be even. (perl 5.6.0 has even more messed
+ # up arithmetic, such that max_natint%2 misleadingly gives the result
+ # 1.)
+ if((max_natint-2) % 2 != 1) {
+ die "Scalar::Number cannot operate in pure Perl due to there ".
+ "being native integer values not exactly ".
+ "representable as native floats combined with ".
+ "uncooperative numeric semantics";
+ }
+ # With that case excluded, it is guaranteed that default arithmetic
+ # will operate correctly on all native integer values when performing
+ # operations within the native integer range. The correctness is
+ # either due to perl 5.8+ numeric semantics, which perform such
+ # operations in native integer arithmetic, or due to all native
+ # integers being losslessly representable in floating point.
+}
# Floating point constants arount max_natint: high_max has the value
# max_natint+1, and low_max is the next lower floating point value.
@@ -74,8 +130,30 @@
(1 << (natint_bits-1));
use constant reduced_high_max => 1 << (natint_bits - (significand_bits+1));
+BEGIN {
+ # We need the refaddr() function from Scalar::Util. However, if
+ # Scalar::Util isn't available then we can reimplement it less
+ # efficiently.
+ eval { local $SIG{__DIE__}; require Scalar::Util; };
+ if($@ eq "") {
+ *refaddr = \&Scalar::Util::refaddr;
+ } else {
+ *refaddr = sub($) {
+ overload::StrVal($_[0]) =~ /0x([0-9a-f]+)\)\z/
+ or die "don't understand StrVal output";
+ return hex_natint($1);
+ };
+ }
+}
+
=head1 FUNCTIONS
+Each "sclnum_" function takes one or more scalar numeric arguments
+to operate on. These arguments must be numeric; giving non-numeric
+arguments will cause mayhem. See L<Params::Classify/is_number> for a way
+to check for numericness. Only the numeric value of the scalar is used;
+the string value is completely ignored, so dualvars are not a problem.
+
=head2 Decomposition
=over
@@ -83,7 +161,7 @@
=item scalar_num_part(SCALAR)
Extracts the numeric value of SCALAR, and returns it as a pure numeric
-scalar.
+scalar. The argument is permitted to be any scalar.
Every scalar has both a string value and a numeric value. In pure string
scalars, those resulting from string literals or string operations,
@@ -108,13 +186,36 @@
"-0+0" => -0.0,
);
sub scalar_num_part($) {
- my($scalar) = @_;
- no warnings "numeric";
- if(have_signed_zero && $scalar == 0) {
- my $val = $_[0];
+ my($val) = @_;
+ no warnings qw(numeric uninitialized);
+ while(ref($val) ne "") {
+ my $meth = overload::Method($val, "0+");
+ return refaddr($val) unless defined $meth;
+ my $newval = eval { local $SIG{__DIE__};
+ $meth->($val, undef, "");
+ };
+ if($@ ne "" || (ref($newval) ne "" &&
+ refaddr($newval) == refaddr($val))) {
+ return refaddr($val);
+ }
+ $val = $newval;
+ }
+ if(have_signed_zero && (my $tval = $val) == 0) {
+ if(!defined($val) || ref(\$val) eq "GLOB") {
+ $val = 0.0;
+ } elsif(do {
+ my $warned;
+ local $SIG{__WARN__} = sub { $warned = 1; };
+ use warnings qw(numeric uninitialized);
+ no warnings "void";
+ 0 + (my $tval = $val);
+ $warned;
+ }) {
+ $val = "0";
+ }
return my $zero = $zero{sprintf("%+.f%+.f", $val, -$val)};
} else {
- return 0 + $scalar;
+ return 0 + $val;
}
}
@@ -126,13 +227,10 @@
=item sclnum_is_natint(VALUE)
-Returns a boolean indicating whether the provided VALUE can be represented
+Returns a truth value indicating whether the provided VALUE can be represented
in the native integer data type. If the floating point type includes
signed zeroes then they do not qualify; the only zero representable in
the integer type is unsigned.
-
-Only the numeric value of the scalar VALUE is examined. The string
-value is ignored.
=cut
@@ -177,13 +275,10 @@
=item sclnum_is_float(VALUE)
-Returns a boolean indicating whether the provided VALUE can be represented
+Returns a truth value indicating whether the provided VALUE can be represented
in the native floating point data type. If the floating point type
includes signed zeroes then an unsigned zero (from the native integer
type) does not qualify.
-
-Only the numeric value of the scalar VALUE is examined. The string
-value is ignored.
=cut
@@ -250,13 +345,20 @@
can be represented exactly in the other's format). <=> performs such
comparisons in floating point, losing accuracy of the integer value.
-Only the numeric values of the scalars A and B are examined. The string
-values are ignored.
-
=cut
sub sclnum_val_cmp($$) {
my($a, $b) = @_;
+ # Due to perl bug #41202, a text->float conversion sometimes
+ # gives the wrong answer, but if a text->integer conversion is
+ # done first then a later integer->float conversion can give a
+ # more accurate answer. Here we trigger such text->integer
+ # conversions, in the situations where it is useful.
+ {
+ no warnings "void";
+ 0 + $a;
+ 0 + $b;
+ }
# Comparison between an integer and a float might be lossy.
# Specifically, it could show values as equal when they're
# not. It can never show equal values as unequal, or give
@@ -300,9 +402,6 @@
In addition to sorting, this function can be useful to check for a zero
of a particular sign.
-Only the numeric values of the scalars A and B are examined. The string
-values are ignored.
-
=cut
my %zero_order = (
@@ -332,11 +431,11 @@
In Perl 5.6, if configured with a wider-than-usual native integer type
such that there are native integers that can't be represented exactly in
the native floating point type, it is not always possible to distinguish
-between integer and floating point values. In order to get the full
-benefit of either type, one is expected (by the numeric semantics) to
-know which of them one is using. This module will not work, and will
-fail its test suite, on such a system. This problem is resolved by Perl
-5.8's new numeric semantics.
+between integer and floating point values in pure Perl code. In order
+to get the full benefit of either type, one is expected (by the numeric
+semantics) to know in advance which of them one is using. The pure Perl
+version of this module can't operate on such a system, but the XS version
+works fine. This problem is resolved by Perl 5.8's new numeric semantics.
=head1 SEE ALSO
@@ -350,7 +449,9 @@
=head1 COPYRIGHT
-Copyright (C) 2007 Andrew Main (Zefram) <zefram at fysh.org>
+Copyright (C) 2007, 2009 Andrew Main (Zefram) <zefram at fysh.org>
+
+=head1 LICENSE
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Modified: trunk/libscalar-number-perl/t/id_cmp.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscalar-number-perl/t/id_cmp.t?rev=34948&op=diff
==============================================================================
--- trunk/libscalar-number-perl/t/id_cmp.t (original)
+++ trunk/libscalar-number-perl/t/id_cmp.t Fri May 8 07:04:00 2009
@@ -1,50 +1,38 @@
-use Test::More tests => 353;
+use Data::Float 0.008 qw(have_signed_zero have_nan have_infinite);
+use Test::More;
-use Data::Float 0.000 qw(have_infinite have_signed_zero have_nan pow2);
-
-BEGIN { use_ok "Scalar::Number", qw(sclnum_id_cmp); }
-
+do "t/num_forms.pl" or die $@ || $!;
my @values = (
- sub { have_nan ? &{"Data::Float::nan"} : undef },
- sub { have_infinite ? &{"Data::Float::neg_infinity"} : undef },
- -pow2(100),
- -1000,
- -123.25,
- -1,
- -0.125,
- sub { have_signed_zero ? &{"Data::Float::neg_zero"} : undef },
- 0,
- sub { have_signed_zero ? &{"Data::Float::pos_zero"} : undef },
- +0.125,
- +1,
- +123.25,
- +1000,
- +pow2(100),
- sub { have_infinite ? &{"Data::Float::pos_infinity"} : undef },
+ have_nan ? [ float_forms("nan") ] : [],
+ have_infinite ? [ float_forms("-inf") ] : [],
+ [ float_forms("-0x1p+130") ],
+ [ natint_forms("-0x401"), float_forms("-0x1.004p+10") ],
+ [ float_forms("-0x1.edp+6") ],
+ [ natint_forms("-0x1"), float_forms("-0x1p+0") ],
+ [ float_forms("-0x1.1p-3") ],
+ have_signed_zero ? [ float_forms(-0.0) ] : [],
+ have_signed_zero ? [ natint_forms(0) ] : [ natint_forms(0), float_forms(0) ],
+ have_signed_zero ? [ float_forms(+0.0) ] : [],
+ [ float_forms("+0x1.1p-3") ],
+ [ natint_forms("+0x1"), float_forms("+0x1p+0") ],
+ [ float_forms("+0x1.edp+6") ],
+ [ natint_forms("+0x401"), float_forms("+0x1.004p+10") ],
+ [ float_forms("+0x1p+130") ],
+ have_infinite ? [ float_forms("+inf") ] : [],
);
-foreach(@values) {
- $_ = $_->() if ref($_) eq "CODE";
-}
+my $nforms = 0;
+$nforms += @$_ foreach @values;
+plan tests => 1 + $nforms*$nforms;
-for(my $ia = @values; $ia--; ) {
- for(my $ib = @values; $ib--; ) {
- SKIP: {
- my $a = $values[$ia];
- my $b = $values[$ib];
- my $a_is_z = ($ia >= 7 && $ia < 10) ? 1 : 0;
- my $b_is_z = ($ib >= 7 && $ib < 10) ? 1 : 0;
- skip "special value not available", 1+$a_is_z+$b_is_z
- unless defined($a) && defined($b);
- my $na = $a;
- my $nb = $b;
- is sclnum_id_cmp($a, $b), ($ia <=> $ib);
- is sprintf("%+.f%+.f%+.f", $a, -$a, - -$a),
- sprintf("%+.f%+.f%+.f", $na, -$na, - -$na)
- if $a_is_z;
- is sprintf("%+.f%+.f%+.f", $b, -$b, - -$b),
- sprintf("%+.f%+.f%+.f", $nb, -$nb, - -$nb)
- if $b_is_z;
- }
- }
-}
+use_ok "Scalar::Number", qw(sclnum_id_cmp);
+
+for(my $ia = @values; $ia--; ) { foreach my $va (@{$values[$ia]}) {
+ for(my $ib = @values; $ib--; ) { foreach my $vb (@{$values[$ib]}) {
+ my($ta, $tb) = ($va, $vb);
+ is sclnum_id_cmp($ta, $tb), ($ia <=> $ib),
+ "id[$ia] <=> id[$ib]";
+ } }
+} }
+
+1;
Modified: trunk/libscalar-number-perl/t/part.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libscalar-number-perl/t/part.t?rev=34948&op=diff
==============================================================================
--- trunk/libscalar-number-perl/t/part.t (original)
+++ trunk/libscalar-number-perl/t/part.t Fri May 8 07:04:00 2009
@@ -1,9 +1,30 @@
-use Test::More tests => 21;
+use Data::Integer 0.003 qw(min_sint max_uint hex_natint);
+use Test::More tests => 1 + 3 + 4*22 + 5*8 + 6*2;
+
+do "t/num_forms.pl" or die $@ || $!;
BEGIN { use_ok "Scalar::Number", qw(scalar_num_part sclnum_id_cmp); }
+foreach my $nzero (0, +0.0, -0.0) {
+ my $tzero = $nzero;
+ scalar_num_part($tzero);
+ is zero_flavour($tzero), zero_flavour($nzero);
+}
+
sub match($$) {
- ok sclnum_id_cmp(scalar_num_part($_[0]), $_[1]) == 0;
+ my $nwarn = 0;
+ local $SIG{__WARN__} = sub { $nwarn++; };
+ my $num_part = scalar_num_part($_[0]);
+ ok sclnum_id_cmp($num_part, $_[1]) == 0;
+ ok +(my $tn = $num_part) == (my $tc = $_[1]);
+ if((my $t = $_[1]) == 0) {
+ my $tn = $num_part;
+ my $tc = $_[1];
+ is zero_flavour($tn), zero_flavour($tc);
+ } else {
+ ok 1;
+ }
+ is $nwarn, 0;
}
match 0, 0;
@@ -16,25 +37,63 @@
match "123abc", 123;
match "1.25", 1.25;
-ok scalar_num_part("00") == 0;
-ok scalar_num_part("0 but true") == 0;
-ok scalar_num_part("xyz") == 0;
+match "00", "0";
+match "0 but true", "0";
+match *match, +0.0;
+match undef, +0.0;
+
+match "0.0", "0.0";
+match "+0.0", "+0.0";
+match "-0.0", "-0.0";
+match "0", "0";
+match "+0", "+0";
+match "-0", "-0";
SKIP: {
eval { require Scalar::Util };
- skip "dualvar() not available", 5 if $@ ne "";
+ skip "dualvar() not available", 4*2 if $@ ne "";
match Scalar::Util::dualvar(123, "xyz"), 123;
match Scalar::Util::dualvar(123, "456"), 123;
- match Scalar::Util::dualvar(0, "456"), Scalar::Util::dualvar(0, 0);
- match Scalar::Util::dualvar(+0.0, "456"),
- Scalar::Util::dualvar(+0.0, +0.0);
- match Scalar::Util::dualvar(-0.0, "456"),
- Scalar::Util::dualvar(-0.0, -0.0);
}
-foreach my $nzero (0, +0.0, -0.0) {
- my $tzero = $nzero;
- scalar_num_part($tzero);
- is sprintf("%+.f%+.f%+.f", $tzero, -$tzero, - -$tzero),
- sprintf("%+.f%+.f%+.f", $nzero, -$nzero, - -$nzero);
+sub refaddr($) {
+ overload::StrVal($_[0]) =~ /0x([0-9a-f]+)\)\z/
+ or die "don't understand StrVal output";
+ return hex_natint($1);
}
+
+my $rt = {};
+match $rt, refaddr($rt);
+
+{
+ package Ovtest;
+ sub new { bless([ $_[1], 0 ]) }
+ use overload "0+" => sub { my($self) = @_; $self->[1]++; $self->[0]; };
+ use overload fallback => 1;
+}
+
+my $ot = Ovtest->new(3);
+match $ot, 3; is $ot->[1], 1;
+$ot = Ovtest->new(0.5);
+match $ot, 0.5; is $ot->[1], 1;
+$ot = Ovtest->new(0);
+match $ot, 0; is $ot->[1], 1;
+$ot = Ovtest->new(+0.0);
+match $ot, +0.0; is $ot->[1], 1;
+$ot = Ovtest->new(-0.0);
+match $ot, -0.0; is $ot->[1], 1;
+$ot = Ovtest->new(do { use integer; min_sint|1 });
+match $ot, do { use integer; min_sint|1 }; is $ot->[1], 1;
+$ot = Ovtest->new(max_uint);
+match $ot, max_uint; is $ot->[1], 1;
+$ot = Ovtest->new(0); $ot->[0] = $ot;
+match $ot, refaddr($ot); is $ot->[1], 1;
+
+my $ot1 = Ovtest->new(max_uint);
+$ot = Ovtest->new($ot1);
+match $ot, max_uint; is $ot->[1], 1; is $ot1->[1], 1;
+$ot1 = Ovtest->new(0); $ot1->[0] = $ot1;
+$ot = Ovtest->new($ot1);
+match $ot, refaddr($ot1); is $ot->[1], 1; is $ot1->[1], 1;
+
+1;
More information about the Pkg-perl-cvs-commits
mailing list