Newer
Older
NetAddr-IP / Lite / t / bignums.t
@Michael Robinton Michael Robinton on 21 Oct 2014 3 KB Import of MIKER/NetAddr-IP-4.050 from CPAN.
  1.  
  2. use strict;
  3. use Test::More;
  4.  
  5. use NetAddr::IP::Lite;
  6. #use NetAddr::IP::Util qw(
  7. # bcd2bin
  8. # ipv6_n2x
  9. # bin2bcd
  10. #);
  11. #use Data::Dumper;
  12.  
  13. my @num = qw(
  14. 2001:468:D01:3C:0:0:80DF:3C1B/128 42540577535367674011024906890208295963
  15. 73.150.6.197/32 1234568901
  16. 128.0.0.0/32 2147483648
  17. 0:0:0:0:0:1:0:0/128 4294967296
  18. 0:0:0:0:0:2:0:0/128 8589934592
  19. 0:0:0:0:0:2:540B:E400/128 10000000000
  20. 0:0:0:0:0:4:0:0/128 17179869184
  21. 0:0:0:0:0:8:0:0/128 34359738368
  22. 0:0:0:0:0:10:0:0/128 68719476736
  23. 0:0:0:0:0:20:0:0/128 137438953472
  24. 0:0:0:0:0:40:0:0/128 274877906944
  25. 0:0:0:0:0:80:0:0/128 549755813888
  26. 0:0:0:0:0:100:0:0/128 1099511627776
  27. 0:0:0:0:0:200:0:0/128 2199023255552
  28. 0:0:0:0:0:400:0:0/128 4398046511104
  29. 0:0:0:0:0:800:0:0/128 8796093022208
  30. 0:0:0:0:0:1000:0:0/128 17592186044416
  31. 0:0:0:0:0:2000:0:0/128 35184372088832
  32. 0:0:0:0:0:4000:0:0/128 70368744177664
  33. 0:0:0:0:0:8000:0:0/128 140737488355328
  34. 0:0:0:0:8000:0:0:0/128 9223372036854775808
  35. 0:0:0:8000:0:0:0:0/128 604462909807314587353088
  36. 0:0:8000:0:0:0:0:0/128 39614081257132168796771975168
  37. 0:8000:0:0:0:0:0:0/128 2596148429267413814265248164610048
  38. 8000:0:0:0:0:0:0:0/128 170141183460469231731687303715884105728
  39. 255.255.255.255/32 4294967295
  40. 1.2.3.4/32 16909060
  41. 10.253.230.9/32 184411657
  42. );
  43.  
  44. plan tests => scalar @num;
  45.  
  46. #diag ("\ntesting SCALARS\n\n");
  47.  
  48. for(my $i = 0;$i <= $#num;$i += 2) {
  49. my $n = $num[$i +1];
  50. my $ip = new NetAddr::IP::Lite($n);
  51. ok($ip eq $num[$i],"$n\t=> got: $ip\texp: ". $num[$i]);
  52. }
  53.  
  54. #diag ("\ntesting Math::BigInt's\n\n");
  55.  
  56. for(my $i = 0;$i <= $#num;$i += 2) {
  57. my $n = new Math::BigInt($num[$i +1]);
  58. my $ip = new NetAddr::IP::Lite($num[$i +1]);
  59. ok($ip eq $num[$i],"$n\t=> got: $ip\texp: ". $num[$i]);
  60. }
  61.  
  62.  
  63.  
  64.  
  65. # simulate the use of Math::BigInt
  66.  
  67. package Math::BigInt;
  68. use strict;
  69.  
  70. use overload
  71. '""' => sub { $_[0]->_str(); };
  72.  
  73. sub BASE_LEN () { 7 };
  74.  
  75. sub _str { # adapted from Math::BigInt::Calc::_str
  76. # (ref to BINT) return num_str
  77. # Convert number from internal base 100000 format to string format.
  78. # internal format is always normalized (no leading zeros, "-0" => "+0")
  79. my $ar = $_[0]->{value};
  80.  
  81. my $l = scalar @$ar; # number of parts
  82. my $ret = "";
  83. # handle first one different to strip leading zeros from it (there are no
  84. # leading zero parts in internal representation)
  85. $l --; $ret .= int($ar->[$l]); $l--;
  86. # Interestingly, the pre-padd method uses more time
  87. # the old grep variant takes longer (14 vs. 10 sec)
  88. my $z = '0' x (BASE_LEN -1);
  89. while ($l >= 0)
  90. {
  91. $ret .= substr($z.$ar->[$l],- BASE_LEN); # fastest way I could think of
  92. $l--;
  93. }
  94. $ret;
  95. }
  96.  
  97. sub new { # adapted from Math::BigInt::new
  98. my ($class,$wanted) = @_;
  99. my $self = bless {}, $class;
  100.  
  101. die "oops, not a good Math::BigInt number"
  102. unless ((!ref $wanted) && ($wanted =~ /^([+-]?)[1-9][0-9]*\z/));
  103. $self->{sign} = $1 || '+';
  104.  
  105. if ($wanted =~ /^[+-]/) {
  106. # remove sign without touching wanted to make it work with constants
  107. my $t = $wanted; $t =~ s/^[+-]//;
  108. $self->{value} = _new($t);
  109. }
  110. else {
  111. $self->{value} = _new($wanted);
  112. }
  113. return $self;
  114. }
  115.  
  116. sub _new { # adapted from Math::BigInt::Calc::_new
  117. my $wanted = $_[0];
  118. # (ref to string) return ref to num_array
  119. # Convert a number from string format (without sign) to internal base
  120. # 1ex format. Assumes normalized value as input.
  121. my $il = length($wanted)-1;
  122.  
  123. # < BASE_LEN due len-1 above
  124. return [ int($wanted) ] if $il < BASE_LEN; # shortcut for short numbers
  125.  
  126. my $base_len = BASE_LEN;
  127. # this leaves '00000' instead of int 0 and will be corrected after any op
  128. [ reverse(unpack("a" . ($il % BASE_LEN +1)
  129. . ("a$base_len" x ($il / BASE_LEN)), $wanted)) ];
  130. }