1#!/usr/bin/env perl
2
3use strict;
4use warnings;
5
6use Config;
7use Math::BigInt;
8use Math::Complex;
9use Test::More tests => 74;
10
11use overload
12    '""'     => sub { '' . $_[0]->[0] },
13    '0+'     => sub { $_[0]->[0] },
14    fallback => 1;
15
16sub new {
17    my $class = shift;
18    bless [ @_ ], $class;
19}
20
21# only debug the value if one or more of its tests fail
22sub diag_if_fail($@) {
23    my $diag = shift;
24    my $fail = 0;
25
26    for my $test (@_) {
27        ++$fail unless ($test->());
28    }
29
30    if ($fail) {
31        $diag = [ $diag ] unless (ref $diag);
32        diag $_ for @$diag;
33    }
34}
35
36use_ok('Scalar::Util::Numeric', qw(:all));
37
38# test overloading
39my $integer = __PACKAGE__->new(42);
40ok($integer, '$integer is set');
41ok($integer == $integer, '$integer == $integer');
42ok($integer == 42, '$integer == 42');
43isa_ok($integer, __PACKAGE__);
44
45my $float = __PACKAGE__->new(3.1415927);
46ok($float, '$float is set');
47ok($float == $float, '$float == $float');
48ok($float == 3.1415927, '$float == 3.1415927');
49isa_ok($float, __PACKAGE__);
50
51my $uvmax = Scalar::Util::Numeric::uvmax();
52
53ok(defined($uvmax), 'uvmax is defined');
54
55my $uvmax_plus_one = Math::BigInt->new($uvmax)->badd(1)->bstr();
56
57ok(defined($uvmax_plus_one), 'uvmax + 1 is defined');
58
59my $infinity = do {
60    no warnings 'once';
61    $Math::Complex::Inf;
62};
63
64ok(defined($infinity), 'infinity is defined');
65
66is (isnum(0), 1, 'isnum(0)');
67is (isnum(1), 1, 'isnum(1)');
68is (isnum(-1), 9, 'isnum(-1)');
69is (isnum('0.00'), 5, "isnum('0.00')");
70is (isnum(undef), 0, "isnum(undef)");
71is (isnum('A'), 0, "isnum('A')");
72is (isnum('A0'), 0, "isnum('A0')");
73is (isnum('0A'), 0, "isnum('0A')");
74is (isnum(sub { }), 0, "isnum(sub { })");
75is (isnum([]), 0, 'isnum([])');
76is (isnum({}), 0, 'isnum({})');
77is (isnum($integer), 1, "isnum(\$integer)");
78is (isnum($float), 5, "isnum(\$float)");
79
80diag_if_fail "UV_MAX: '$uvmax'" =>
81    sub { is (isuv($uvmax), 1, 'isuv($uvmax)') },
82    sub { is (isuv(-1), 1, "isuv(-1)") };
83
84diag_if_fail [ "UV_MAX: '$uvmax'", "UV_MAX + 1: '$uvmax_plus_one'" ] =>
85    sub { is (isbig($uvmax), 0, "isbig(\$uvmax)") },
86    sub { is (isbig($uvmax_plus_one), 1, "isbig(\$uvmax + 1)") };
87
88is (isfloat(3.1415927), 1, "isfloat(3.1415927)");
89is (isfloat(-3.1415927), 1, "isfloat(-3.1415927)");
90is (isfloat(3), 0, "isfloat(3)");
91is (isfloat("1.0"), 1, "isfloat('1.0')");
92is (isfloat($float), 1, "isfloat(\$float)");
93
94is (isneg(-1), 1, "isneg(-1)");
95is (isneg(-3.1415927), 1, "isneg(-3.1415927)");
96is (isneg(1), 0, "isneg(1)");
97is (isneg(3.1415927), 0, "isneg(3.1415927)");
98
99diag_if_fail "INFINITY: '$infinity'" =>
100    sub { is (isinf('Inf'), 1, "isinf('Inf')") },
101    sub { is (isinf(3.1415927), 0, "isinf(3.1415927)") },
102    sub { is (isinf($infinity), 1, 'isinf($Math::Complex::Inf)') };
103
104is (isint(-99), -1, "isint(-99) == -1");
105is (isint(0), 1, "isint(0)");
106is (isint(3.1415927), 0, "isint(3.1415927)");
107is (isint(-3.1415927), 0, "isint(-3.1415927)");
108is (isint($uvmax), 1, 'isint($uvmax)');
109is (isint($infinity), 0, 'isint($Math::Complex::Inf)');
110is (isint("1.0"), 0, "isint('1.0')");
111is (isint($integer), 1, "isint(\$integer)");
112is (isint($float), 0, "isint(\$float)");
113
114SKIP: {
115    skip ('NaN is not supported by this platform', 2) unless($Config{d_isnan});
116
117    # this also tests handling of objects with overloaded stringification
118    my $nan = Math::BigInt->bnan;
119
120    diag_if_fail "NAN: '$nan'" =>
121        sub { is (isnan('NaN'), 1, "isnan('NaN')") },
122        sub { is (isnan(42), 0, "isnan(42)") };
123}
124
125# test the assumed Inf/NaN values on Windows
126SKIP: {
127    skip ('Windows only', 10) unless($^O eq 'MSWin32');
128
129    my $infinity = '1.#INF';
130
131    diag_if_fail "INFINITY: '$infinity'" =>
132        sub { is (isinf($infinity), 1, "isinf('$infinity')") },
133        sub { is (isinf("-$infinity"), 1, "isinf('-$infinity')") },
134        sub { is (isinf(3.1415927), 0, "isinf(3.1415927)") },
135        sub { is (isinf(42), 0, "isinf(42)") },
136        sub { is (isint($infinity), 0, "isint('$infinity')") },
137        sub { is (isint("-$infinity"), 0, "isint('-$infinity')") };
138
139    my $nan = '1.#IND';
140
141    diag_if_fail "NaN: '$nan'" =>
142        sub { is (isnan($nan), 1, "isnan('$nan')") },
143        sub { is (isnan("-$nan"), 1, "isnan('-$nan')") },
144        sub { is (isnan(3.1415927), 0, "isnan(3.1415927)") },
145        sub { is (isnan(42), 0, "isnan(42)") };
146}
147
148# throw in some near-misses (wrong spelling) for the Win32 Inf and NaN
149# these should be invalid numbers on all platforms
150# note that letter-case variants are specifically permitted
151for my $fail ('1.#IMD', '-1.#IMD', '1.#IMF', '-1.#IMF') {
152    ok !isint($fail), "!isint($fail)";
153    ok !isinf($fail), "!isinf($fail)";
154    ok !isnan($fail), "!isnan($fail)";
155}
156