Fork: 0
x-way / NetAddr-IP
Transfer to URL with SHA Find file
Newer
Older
NetAddr-IP / Lite / Util / t / add128.t
@Luis Muñoz Luis Muñoz on 21 Oct 2014 3 KB Import of LUISMUNOZ/NetAddr-IP-4.001 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..57\n"; }
  9. END {print "not ok 1\n" unless $loaded;}
  10.  
  11. use NetAddr::IP::Util qw(
  12. 	add128
  13. 	sub128
  14. 	ipv6_aton
  15. 	ipv6_n2x
  16. 	comp128
  17. );
  18.  
  19. $loaded = 1;
  20. print "ok 1\n";
  21. ######################### End of black magic.
  22.  
  23. # Insert your test code below (better if it prints "ok 13"
  24. # (correspondingly "not ok 13") depending on the success of chunk 13
  25. # of the test code):
  26.  
  27. $test = 2;
  28.  
  29. sub ok {
  30.   print "ok $test\n";
  31.   ++$test;
  32. }
  33.  
  34. my @num = # 	number					plus	      		      carry		exp
  35. qw(
  36. 	FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE		::1				0	FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF
  37. 	::1				FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE		0	FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF
  38. 	::2				FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE		1	0:0:0:0:0:0:0:0
  39. 	FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE		::2				1	0:0:0:0:0:0:0:0
  40. 	FFFF:FFFF:FFFF:FFFF:FFFF:8FFF:FFFF:FFFE		::7000:0:2			1	0:0:0:0:0:0:0:0
  41. 	FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE		::3				1	0:0:0:0:0:0:0:1
  42. 	::1						::2				0	0:0:0:0:0:0:0:3
  43. 	::FFFF						::FFFF				0	0:0:0:0:0:0:1:FFFE
  44. 	::FFFF:FFFF					::FFFF:FFFF			0	0:0:0:0:0:1:FFFF:FFFE
  45. 	::FFFF:FFFF:FFFF			::FFFF:FFFF:FFFF			0	0:0:0:0:1:FFFF:FFFF:FFFE
  46. 	::FFFF:FFFF:FFFF:FFFF			::FFFF:FFFF:FFFF:FFFF			0	0:0:0:1:FFFF:FFFF:FFFF:FFFE
  47. 	::FFFF:FFFF:FFFF:FFFF:FFFF		::FFFF:FFFF:FFFF:FFFF:FFFF		0	0:0:1:FFFF:FFFF:FFFF:FFFF:FFFE
  48. 	::FFFF:FFFF:FFFF:FFFF:FFFF:FFFF		::FFFF:FFFF:FFFF:FFFF:FFFF:FFFF		0	0:1:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE
  49. 	::FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF	::FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF	0	1:FFFF:FFFF:FFFF:FFFF:FFFF:FFFF:FFFE
  50. );
  51.  
  52. ## test 2 - 15	check carry
  53. for (my $i=0; $i<@num; $i+=4) {
  54.   my $num = ipv6_aton($num[$i]);
  55.   my $plus = ipv6_aton($num[$i +1]);
  56.   my $rv = add128($num,$plus);
  57.   print "got: $rv, exp: $num[$i +2]\nnot "
  58. 	unless $rv == $num[$i +2];
  59.   &ok;
  60. }
  61. ## test  16 - 43	check carry + result
  62. for (my $i=0; $i<@num; $i+=4) {
  63.   my $num = ipv6_aton($num[$i]);
  64.   my $plus = ipv6_aton($num[$i +1]);
  65.   my($rv,$result) = add128($num,$plus);
  66.   print "got: $rv, exp: $num[$i +2]\nnot "
  67. 	unless $rv == $num[$i +2];
  68.   &ok;
  69.   $result = ipv6_n2x($result);
  70.   print "got: $result\nexp: $num[$i +3]\nnot "
  71. 	unless $result eq $num[$i +3];
  72.   &ok;
  73. }
  74.  
  75. ## test 44 - 57	the subtraction of the comp of the 'plus' category
  76. ##		should invert the carry and add 1 to 'exp'
  77. ##		start test at first 'number' that starts with '::FFFF'
  78. for (my $i=0; $i<@num; $i+=4) {
  79.   next unless $num[$i] =~ /^::FFFF/;
  80.   my $num = ipv6_aton($num[$i]);
  81.   my $plus = ipv6_aton($num[$i +1]);
  82.   my $minus = comp128($plus);
  83.   my($rv,$result) = sub128($num,$minus);
  84.   print "got: $rv, exp: $num[$i +2]\nnot "
  85. 	unless $rv == $num[$i +2];
  86.   &ok;
  87.   $num[$i +3] =~ s/FFFE$/FFFF/;
  88.   $result = ipv6_n2x($result);
  89.   print "got: $result\nexp: $num[$i +3]\nnot "
  90. 	unless $result eq $num[$i +3];
  91.   &ok;
  92. }