Fork: 0
x-way / NetAddr-IP
Transfer to URL with SHA Find file
Newer
Older
NetAddr-IP / Lite / t / v6-new_cis6_base.t
@Michael Robinton Michael Robinton on 21 Oct 2014 2 KB Import of MIKER/NetAddr-IP-4.035 from CPAN.
Raw Blame History 
  1. # This -*- perl -*- code excercises the basic v6 functionality
  2.  
  3. sub mypass() {1}
  4. sub myfail() {0}
  5.  
  6. @addr =
  7.     (
  8.      ['::',  3, '0:0:0:0:0:0:0:0/128',myfail],
  9.      ['::1', 3, '0:0:0:0:0:0:0:1/128',myfail],
  10.      ['F34::123 40', 2, 'F34:0:0:0:0:0:0:3/40',mypass],
  11.      ['DEAD:BEEF::1 40', 2, 'DEAD:BEEF:0:0:0:0:0:3/40',mypass],
  12.      ['1000::2 40', 0, '1000:0:0:0:0:0:0:1/40',mypass],
  13.      ['1000::2000 40', 0, '1000:0:0:0:0:0:0:1/40',mypass],
  14.      ['DEAD::CAFE 40', 0, 'DEAD:0:0:0:0:0:0:1/40',mypass],
  15.      ['DEAD:BEEF::1 40', 3, 'DEAD:BEEF:0:0:0:0:0:4/40',mypass],
  16.      ['DEAD:BEEF::1 40', 4, 'DEAD:BEEF:0:0:0:0:0:5/40',mypass],
  17.      ['DEAD:BEEF::1 40', 5, 'DEAD:BEEF:0:0:0:0:0:6/40',mypass],
  18.      ['DEAD:BEEF::1 40', 6, 'DEAD:BEEF:0:0:0:0:0:7/40',mypass],
  19.      ['DEAD:BEEF::1 40', 7, 'DEAD:BEEF:0:0:0:0:0:8/40',mypass],
  20.      ['DEAD:BEEF::1 40', 8, 'DEAD:BEEF:0:0:0:0:0:9/40',mypass],
  21.      ['DEAD:BEEF::1 40', 254, 'DEAD:BEEF:0:0:0:0:0:FF/40',mypass],
  22.      ['DEAD:BEEF::1 40', 255, 'DEAD:BEEF:0:0:0:0:0:100/40',mypass],
  23.      ['DEAD:BEEF::1 40', 256, 'DEAD:BEEF:0:0:0:0:0:101/40',mypass],
  24.      ['DEAD:BEEF::1 40', 65535, 'DEAD:BEEF:0:0:0:0:1:0/40',mypass],
  25.      ['DEAD:BEEF::1 40', 65536, 'DEAD:BEEF:0:0:0:0:1:1/40',mypass],
  26.      ['2001:620:0:4::/64', 0, '2001:620:0:4:0:0:0:1/64',mypass],
  27.      ['3FFE:2000:0:4::/64', 0, '3FFE:2000:0:4:0:0:0:1/64',mypass],
  28.      ['2001:620:600::1', 0, '2001:620:600:0:0:0:0:1/128',mypass],
  29.      ['2001:620:600:0:1::1', 0,'2001:620:600:0:1:0:0:1/128',mypass],
  30.      );
  31.  
  32. use NetAddr::IP::Lite;
  33. use Test::More;
  34.  
  35. my($a, $ip, $test);
  36.  
  37. $test = 4 * @addr + 4;
  38. plan tests => $test;
  39.  
  40. $test = 1;
  41.  
  42. sub tst {
  43.   for $a (@addr) {
  44. 	$ip = new_cis6 NetAddr::IP::Lite $a->[0];
  45. 	$a->[0] =~ s,/\d+,,;
  46. 	isa_ok($ip, 'NetAddr::IP::Lite', "$a->[0] ");
  47. # requires full NetAddr::IP
  48. #	is(uc $ip->short, $a->[0], "short returns $a->[0]");
  49. 	is($ip->bits, 128, "bits == 128");
  50. 	is($ip->version, 6, "version == 6");
  51. 	my $index = $a->[1];
  52. 	if ($a->[3]) {
  53. 	  is(uc $ip->nth($index), $a->[2], "nth $a->[0], $index");
  54. 	} else {
  55. 	  ok(!$ip->nth($index),"nth $a->[0], undef");
  56. 	}
  57.  }
  58. }
  59.  
  60. tst();
  61.  
  62. $test = new_cis6 NetAddr::IP::Lite 'f34::1';
  63. isa_ok($test, 'NetAddr::IP::Lite');
  64. ok($test->network->contains($test), "->contains");
  65.  
  66. $test = new_cis6 NetAddr::IP::Lite 'f35::1 40';
  67. isa_ok($test, 'NetAddr::IP::Lite');
  68. ok($test->network->contains($test), "->contains");
  69.