Fork: 0
x-way / NetAddr-IP
Transfer to URL with SHA Find file
Newer
Older
NetAddr-IP / Lite / Util / t / bin.t
@Michael Robinton Michael Robinton on 21 Oct 2014 2 KB Import of MIKER/NetAddr-IP-4.020 from CPAN.
Raw Blame History 
  1. # Before `make install' is performed this script should be runnable with
  2. # `make test'. After `make install' it should work as `perl test.pl'
  3.  
  4. ######################### We start with some black magic to print on failure.
  5. # Change 1..1 below to 1..last_test_to_print .
  6. # (It may become useful if the test is moved to ./t subdirectory.)
  7.  
  8. BEGIN { $| = 1; print "1..25\n"; }
  9. END {print "not ok 1\n" unless $loaded;}
  10.  
  11. use NetAddr::IP::Util qw(
  12. 	ipv6_aton
  13. 	bin2bcd
  14. 	bin2bcdn
  15. 	bcdn2txt
  16. );
  17.  
  18. $loaded = 1;
  19. print "ok 1\n";
  20. ######################### End of black magic.
  21.  
  22. # Insert your test code below (better if it prints "ok 13"
  23. # (correspondingly "not ok 13") depending on the success of chunk 13
  24. # of the test code):
  25.  
  26. $test = 2;
  27.  
  28. sub ok {
  29.   print "ok $test\n";
  30.   ++$test;
  31. }
  32.  
  33. # input: array ref, value ref, number ref
  34. #
  35. sub val {
  36.   my $bcd = shift;
  37.   my $rv = unpack("H*",$bcd);
  38.   $rv =~ s/^0+(\d)/$1/g;
  39.   return $rv;
  40. }
  41.  
  42. sub numnum {
  43.   my($ar,$i) = @_;
  44.   return sprintf("%.0f",$ar->[$i +1]);
  45. }
  46.  
  47. sub numstr {
  48.   my($ar,$i) = @_;
  49.   return $ar->[$i+1];
  50. }
  51.  
  52. sub dotest {
  53.   my($ar,$vr,$nr) = @_;
  54.   for(my $i=0;$i<@$ar;$i+=2) {
  55.     my $bstr = ipv6_aton($ar->[$i]);
  56.     my $bcd = bin2bcdn($bstr);
  57.     my $val = $vr->($bcd);
  58.     my $exp = $nr->($ar,$i);
  59.     print "\t\t$val\n";
  60.     print "got: $val\nexp: $exp\nnot "
  61. 	unless $val eq $exp;
  62.     &ok;
  63.   }
  64. }
  65.  
  66. # setup only, can't depend on float to do it right on all systems
  67. #my @num1 =    # input			expected
  68. #(
  69. #	'::'			=>	0,
  70. #	'::8000:0'		=>	2**(15+16),
  71. #	'::8000:0:0'		=>	2**(15+(16*2)),
  72. #	'::8000:0:0:0'		=>	2**(15+(16*3)),
  73. #	'::8000:0:0:0:0'	=>	2**(15+(16*4)),
  74. #	'::8000:0:0:0:0:0'	=>	2**(15+(16*5)),
  75. #	'::8000:0:0:0:0:0:0'	=>	2**(15+(16*6)),
  76. #	'8000:0:0:0:0:0:0:0'	=>	2**(15+(16*7)),
  77. #);
  78.  
  79. my @num2 = qw(
  80. 	::				0
  81. 	::8000:0			2147483648
  82. 	::8000:0:0			140737488355328
  83. 	::8000:0:0:0			9223372036854775808
  84. 	::8000:0:0:0:0			604462909807314587353088
  85. 	::8000:0:0:0:0:0		39614081257132168796771975168
  86. 	::8000:0:0:0:0:0:0		2596148429267413814265248164610048
  87. 	8000:0:0:0:0:0:0:0		170141183460469231731687303715884105728
  88. );
  89.  
  90. ## tests 2 - 9		bin2bcdn numeric unpack
  91. #dotest(\@num1,\&val,\&numnum);
  92.  
  93. ## tests 10 - 17	bin2bcdn string unpack		TEST 2 - 9
  94. dotest(\@num2,\&val,\&numstr);
  95.  
  96. ## tests 18 - 25	bin2bcdn numeric bcdn2txt
  97. #dotest(\@num1,\&bcdn2txt,\&numnum);
  98.  
  99. ## tests 26 - 33	bin2bcdn string bcdn2txt	TEST 10 - 17
  100. dotest(\@num2,\&bcdn2txt,\&numstr);
  101.  
  102. ## tests 34 - 41	bin2bcd				TEST 18 - 25
  103. for(my $i=0;$i<@num2;$i+=2) {
  104.   my $bstr = ipv6_aton($num2[$i]);
  105.   my $bcd = bin2bcd($bstr);
  106.   my $exp = $num2[$i +1];
  107.   print "\t\t$bcd\n";
  108.   print "got: $bcd\nexp: $exp\nnot "
  109. 	unless $bcd eq $exp;
  110.   &ok;
  111. }