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