Newer
Older
NetAddr-IP / Lite / Util / t / isIPv4.t
@Michael Robinton Michael Robinton on 21 Oct 2014 2 KB Import of MIKER/NetAddr-IP-4.065 from CPAN.
  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..421\n"; }
  9. END {print "not ok 1\n" unless $loaded;}
  10.  
  11. use NetAddr::IP::Util qw(
  12. ipv6_aton
  13. ipv6_n2x
  14. isIPv4
  15. isNewIPv4
  16. isAnyIPv4
  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 = qw # input
  35. (
  36. ::
  37. 8000::
  38. 4000::
  39. 2000::
  40. 1000::
  41. 800::
  42. 400::
  43. 200::
  44. 100::
  45. 80::
  46. 40::
  47. 20::
  48. 10::
  49. 1::
  50. 0:8000::
  51. 0:4000::
  52. 0:2000::
  53. 0:1000::
  54. 0:800::
  55. 0:400::
  56. 0:200::
  57. 0:100::
  58. 0:80::
  59. 0:40::
  60. 0:20::
  61. 0:10::
  62. 0:1::
  63. 0:0:8000::
  64. 0:0:4000::
  65. 0:0:2000::
  66. 0:0:1000::
  67. 0:0:800::
  68. 0:0:400::
  69. 0:0:200::
  70. 0:0:100::
  71. 0:0:80::
  72. 0:0:40::
  73. 0:0:20::
  74. 0:0:10::
  75. 0:0:1::
  76. 0:0:0:8000::
  77. 0:0:0:4000::
  78. 0:0:0:2000::
  79. 0:0:0:1000::
  80. 0:0:0:800::
  81. 0:0:0:400::
  82. 0:0:0:200::
  83. 0:0:0:100::
  84. 0:0:0:80::
  85. 0:0:0:40::
  86. 0:0:0:20::
  87. 0:0:0:10::
  88. 0:0:0:1::
  89. 0:0:0:0:8000::
  90. 0:0:0:0:4000::
  91. 0:0:0:0:2000::
  92. 0:0:0:0:1000::
  93. 0:0:0:0:800::
  94. 0:0:0:0:400::
  95. 0:0:0:0:200::
  96. 0:0:0:0:100::
  97. 0:0:0:0:80::
  98. 0:0:0:0:40::
  99. 0:0:0:0:20::
  100. 0:0:0:0:10::
  101. 0:0:0:0:1::
  102. 0:0:0:0:0:8000::
  103. 0:0:0:0:0:4000::
  104. 0:0:0:0:0:2000::
  105. 0:0:0:0:0:1000::
  106. 0:0:0:0:0:800::
  107. 0:0:0:0:0:400::
  108. 0:0:0:0:0:200::
  109. 0:0:0:0:0:100::
  110. 0:0:0:0:0:80::
  111. 0:0:0:0:0:40::
  112. 0:0:0:0:0:20::
  113. 0:0:0:0:0:10::
  114. 0:0:0:0:0:1::
  115. ::8000:0
  116. ::4000:0
  117. ::2000:0
  118. ::1000:0
  119. ::800:0
  120. ::400:0
  121. ::200:0
  122. ::100:0
  123. ::80:0
  124. ::40:0
  125. ::20:0
  126. ::10:0
  127. ::1:0
  128. ::8000
  129. ::4000
  130. ::2000
  131. ::1000
  132. ::800
  133. ::400
  134. ::200
  135. ::100
  136. ::80
  137. ::40
  138. ::20
  139. ::10
  140. ::1
  141. );
  142.  
  143. # check isIPv4
  144.  
  145. foreach (@num) {
  146. my $bstr = ipv6_aton($_);
  147. my $rv = isIPv4($bstr);
  148. my $exp = ($_ =~ /\d::$/) ? 0:1;
  149. print "got: $rv, exp: $exp for ", ipv6_n2x($bstr), "\nnot "
  150. unless $rv eq $exp;
  151. &ok;
  152. }
  153.  
  154. # check isAnyIPv4
  155. foreach (@num) {
  156. my $bstr = ipv6_aton($_);
  157. my $rv = isAnyIPv4($bstr);
  158. my $exp = ($_ =~ /\d::$/) ? 0:1;
  159. print "got: $rv, exp: $exp for ", ipv6_n2x($bstr), "\nnot "
  160. unless $rv eq $exp;
  161. &ok;
  162. }
  163.  
  164. my $compat = ipv6_aton('::FFFF:0:0');
  165.  
  166. # check isAnyIPv4 with compatible high bits
  167. foreach (@num) {
  168. my $bstr = ipv6_aton($_);
  169. $bstr ^= $compat;
  170. my $rv = isAnyIPv4($bstr);
  171. my $exp = ($_ =~ /\d::$/) ? 0:1;
  172. print "got: $rv, exp: $exp for ", ipv6_n2x($bstr), "\nnot "
  173. unless $rv eq $exp;
  174. &ok;
  175. }
  176.  
  177. # check isNewIPv4 with compatible high bits
  178. foreach (@num) {
  179. my $bstr = ipv6_aton($_);
  180. $bstr ^= $compat;
  181. my $rv = isNewIPv4($bstr);
  182. my $exp = ($_ =~ /\d::$/) ? 0:1;
  183. print "got: $rv, exp: $exp for ", ipv6_n2x($bstr), "\nnot "
  184. unless $rv eq $exp;
  185. &ok;
  186. }