1# -*- mode: perl; -*- 2 3use strict; 4use warnings; 5 6use Test::More tests => 106; 7 8use Scalar::Util qw< refaddr >; 9 10my $class; 11 12BEGIN { $class = 'Math::BigInt'; } 13BEGIN { use_ok($class); } 14 15while (<DATA>) { 16 s/#.*$//; # remove comments 17 s/\s+$//; # remove trailing whitespace 18 next unless length; # skip empty lines 19 20 my ($in0, $out0) = split /:/; 21 my $x; 22 my $test = qq|\$x = $class -> new("$in0");|; 23 my $desc = $test; 24 25 eval $test; 26 die $@ if $@; # this should never happen 27 28 subtest $desc, sub { 29 plan tests => 2, 30 31 # Check output. 32 33 is(ref($x), $class, "output arg is a $class"); 34 is($x, $out0, 'output arg has the right value'); 35 }; 36 37} 38 39# new() 40 41{ 42 my $x = $class -> new(); 43 subtest qq|\$x = $class -> new();|, => sub { 44 plan tests => 2; 45 46 is(ref($x), $class, "output arg is a $class"); 47 is($x, "0", 'output arg has the right value'); 48 }; 49} 50 51# new("") 52 53{ 54 no warnings "numeric"; 55 my $x = $class -> new(""); 56 subtest qq|\$x = $class -> new("");|, => sub { 57 plan tests => 2; 58 59 is(ref($x), $class, "output arg is a $class"); 60 #is($x, "0", 'output arg has the right value'); 61 is($x, "NaN", 'output arg has the right value'); 62 }; 63} 64 65# new(undef) 66 67{ 68 no warnings "uninitialized"; 69 my $x = $class -> new(undef); 70 subtest qq|\$x = $class -> new(undef);|, => sub { 71 plan tests => 2; 72 73 is(ref($x), $class, "output arg is a $class"); 74 is($x, "0", 'output arg has the right value'); 75 }; 76} 77 78# new($x) 79# 80# In this case, when $x isa Math::BigInt, only the sign and value should be 81# copied from $x, not the accuracy or precision. 82 83{ 84 my ($a, $p, $x, $y); 85 86 $a = $class -> accuracy(); # get original 87 $class -> accuracy(4711); # set new global value 88 $x = $class -> new("314"); # create object 89 $x -> accuracy(41); # set instance value 90 $y = $class -> new($x); # create new object 91 is($y -> accuracy(), 4711, 'object has the global accuracy'); 92 $class -> accuracy($a); # reset 93 94 $p = $class -> precision(); # get original 95 $class -> precision(4711); # set new global value 96 $x = $class -> new("314"); # create object 97 $x -> precision(41); # set instance value 98 $y = $class -> new($x); # create new object 99 is($y -> precision(), 4711, 'object has the global precision'); 100 $class -> precision($p); # reset 101} 102 103# Make sure that library thingies are indeed copied. 104 105{ 106 my ($x, $y); 107 108 $x = $class -> new("314"); # create object 109 $y = $class -> new($x); # create new object 110 subtest 'library thingy is copied' => sub { 111 my @keys = ('value'); 112 plan tests => scalar @keys; 113 for my $key (@keys) { 114 isnt(refaddr($y -> {$key}), refaddr($x -> {$key}), 115 'library thingy is a copy'); 116 } 117 }; 118} 119 120__END__ 121 122NaN:NaN 123inf:inf 124infinity:inf 125+inf:inf 126+infinity:inf 127-inf:-inf 128-infinity:-inf 129 130# This is the same data as in from_bin-mbf.t, except that some of them are 131# commented out, since new() only treats input as binary if it has a "0b" or 132# "0B" prefix, possibly with a leading "+" or "-" sign. Duplicates from above 133# are also commented out. 134 1350b1p+0:1 1360b.1p+1:1 1370b.01p+2:1 1380b.001p+3:1 1390b.0001p+4:1 1400b10p-1:1 1410b100p-2:1 1420b1000p-3:1 143 144-0b1p+0:-1 145 1460b0p+0:0 1470b0p+7:0 1480b0p-7:0 1490b0.p+0:0 1500b.0p+0:0 1510b0.0p+0:0 152 1530b1100101011111110:51966 1540B1100101011111110:51966 155b1100101011111110:51966 156B1100101011111110:51966 157#1100101011111110:51966 158 1590b1.1001p+3:NaN 1600b10010.001101p-1:NaN 161-0b.11110001001101010111100110111101111p+31:NaN 1620b10.0100011010001010110011110001001101p+34:39093746765 163 1640b.p+0:NaN 165 166#NaN:NaN 167#+inf:NaN 168#-inf:NaN 169 170# This is more or less the same data as in from_oct-mbf.t, except that some of 171# them are commented out, since new() does not consider a number with just a 172# leading zero to be an octal number. Duplicates from above are also commented 173# out. 174 175# Without "0o" prefix. 176 177001p+0:1 17800.4p+1:1 17900.2p+2:1 18000.1p+3:1 18100.04p+4:1 18202p-1:1 18304p-2:1 184010p-3:1 185 186-01p+0:-1 187 18800p+0:0 18900p+7:0 19000p-7:0 19100.p+0:0 19200.0p+0:0 193 194#145376:51966 195#0145376:51966 196#00145376:51966 197 19803.1p+2:NaN 199022.15p-1:NaN 200-00.361152746757p+32:NaN 201044.3212636115p+30:39093746765 202 2030.p+0:NaN 204.p+0:NaN 205 206# With "0o" prefix. 207 2080o01p+0:1 2090o0.4p+1:1 2100o0.2p+2:1 2110o0.1p+3:1 2120o0.04p+4:1 2130o02p-1:1 2140o04p-2:1 2150o010p-3:1 216 217-0o1p+0:-1 218 2190o0p+0:0 2200o0p+7:0 2210o0p-7:0 2220o0.p+0:0 2230o.0p+0:0 2240o0.0p+0:0 225 2260o145376:51966 2270O145376:51966 228o145376:51966 229O145376:51966 230 2310o3.1p+2:NaN 2320o22.15p-1:NaN 233-0o0.361152746757p+32:NaN 2340o44.3212636115p+30:39093746765 235 2360o.p+0:NaN 237 238#NaN:NaN 239#+inf:NaN 240#-inf:NaN 241 242# This is the same data as in from_hex-mbf.t, except that some of them are 243# commented out, since new() only treats input as hexadecimal if it has a "0x" 244# or "0X" prefix, possibly with a leading "+" or "-" sign. 245 2460x1p+0:1 2470x.8p+1:1 2480x.4p+2:1 2490x.2p+3:1 2500x.1p+4:1 2510x2p-1:1 2520x4p-2:1 2530x8p-3:1 254 255-0x1p+0:-1 256 2570x0p+0:0 2580x0p+7:0 2590x0p-7:0 2600x0.p+0:0 2610x.0p+0:0 2620x0.0p+0:0 263 2640xcafe:51966 2650Xcafe:51966 266xcafe:51966 267Xcafe:51966 268#cafe:51966 269 2700x1.9p+3:NaN 2710x12.34p-1:NaN 272-0x.789abcdefp+32:NaN 2730x12.3456789ap+31:39093746765 274 2750x.p+0:NaN 276 277#NaN:NaN 278#+inf:NaN 279#-inf:NaN 280