Advertisement
Guest User

Untitled

a guest
Sep 2nd, 2011
170
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 10.47 KB | None | 0 0
  1. diff --git a/lib/Test.pm b/lib/Test.pm
  2. index 46d3a9c..7a0cc76 100644
  3. --- a/lib/Test.pm
  4. +++ b/lib/Test.pm
  5. @@ -13,8 +13,8 @@ my $num_of_tests_planned;
  6. my $no_plan = 1;
  7. my $die_on_fail;
  8. my $perl6_test_times = ? %*ENV<PERL6_TEST_TIMES>;
  9. -my $time_before = 0E0;
  10. -my $time_after = 0E0;
  11. +my $time_before;
  12. +my $time_after;
  13.  
  14. ## If done_testing hasn't been run when we hit our END block, we need to know
  15. ## so that it can be run. This allows compatibility with old tests that use
  16. @@ -46,39 +46,54 @@ multi sub plan($number_of_tests) {
  17.  
  18. say '1..' ~ $number_of_tests;
  19. }
  20. - # Get two successive timestamps to measure the measurement overhead,
  21. - # and to reduce bias, if it exists, from the first test time.
  22. + # Get two successive timestamps to say how long it takes to read the
  23. + # clock, and to let the first test timing work just like the rest.
  24. + # These readings should be made with the expression now.to-posix[0],
  25. + # but its execution time when tried in the following two lines is a
  26. + # lot slower than the non portable nqp::p6box_n(pir::time__N).
  27. $time_before = nqp::p6box_n(pir::time__N);
  28. $time_after = nqp::p6box_n(pir::time__N);
  29. say '# between two timestamps ' ~
  30. ceiling(($time_after-$time_before)*1_000_000) ~ ' microseconds'
  31. if $perl6_test_times;
  32. + # Take one more reading to serve as the begin time of the first test
  33. $time_before = nqp::p6box_n(pir::time__N);
  34. - # Ideally the time readings above could be made with the expression
  35. - # now.to-posix[0], but the execution time showed by the difference
  36. - # between the two successive readings is far slower than when the
  37. - # non portable pir::time__N is used instead.
  38. }
  39.  
  40. proto sub pass(|$) is export { * }
  41. multi sub pass($desc) {
  42. + $time_after = nqp::p6box_n(pir::time__N);
  43. proclaim(1, $desc);
  44. + $time_before = nqp::p6box_n(pir::time__N);
  45. }
  46.  
  47. proto sub ok(|$) is export { * }
  48. multi sub ok(Mu $cond, $desc) {
  49. + $time_after = nqp::p6box_n(pir::time__N);
  50. proclaim(?$cond, $desc);
  51. + $time_before = nqp::p6box_n(pir::time__N);
  52. +}
  53. +multi sub ok(Mu $cond) {
  54. + $time_after = nqp::p6box_n(pir::time__N);
  55. + proclaim(?$cond, '');
  56. + $time_before = nqp::p6box_n(pir::time__N);
  57. }
  58. -multi sub ok(Mu $cond) { ok(?$cond, ''); }
  59.  
  60. proto sub nok(|$) is export { * }
  61. multi sub nok(Mu $cond, $desc) {
  62. + $time_after = nqp::p6box_n(pir::time__N);
  63. proclaim(!$cond, $desc);
  64. + $time_before = nqp::p6box_n(pir::time__N);
  65. +}
  66. +multi sub nok(Mu $cond) {
  67. + $time_after = nqp::p6box_n(pir::time__N);
  68. + proclaim(!$cond, '');
  69. + $time_before = nqp::p6box_n(pir::time__N);
  70. }
  71. -multi sub nok(Mu $cond) { nok($cond, ''); }
  72.  
  73. proto sub is(|$) is export { * }
  74. multi sub is(Mu $got, Mu $expected, $desc) {
  75. + $time_after = nqp::p6box_n(pir::time__N);
  76. $got.defined; # Hack to deal with Failures
  77. my $test = $got eq $expected;
  78. proclaim(?$test, $desc);
  79. @@ -87,18 +102,38 @@ multi sub is(Mu $got, Mu $expected, $desc) {
  80. diag "expected: '$expected'";
  81. }
  82. $test;
  83. + $time_before = nqp::p6box_n(pir::time__N);
  84. +}
  85. +multi sub is(Mu $got, Mu $expected) {
  86. + $time_after = nqp::p6box_n(pir::time__N);
  87. + $got.defined; # Hack to deal with Failures
  88. + my $test = $got eq $expected;
  89. + proclaim(?$test, '');
  90. + if !$test {
  91. + diag " got: '$got'";
  92. + diag "expected: '$expected'";
  93. + }
  94. + $test;
  95. + $time_before = nqp::p6box_n(pir::time__N);
  96. }
  97. -multi sub is(Mu $got, Mu $expected) { is($got, $expected, ''); }
  98.  
  99. proto sub isnt(|$) is export { * }
  100. multi sub isnt(Mu $got, Mu $expected, $desc) {
  101. + $time_after = nqp::p6box_n(pir::time__N);
  102. my $test = !($got eq $expected);
  103. proclaim($test, $desc);
  104. + $time_before = nqp::p6box_n(pir::time__N);
  105. +}
  106. +multi sub isnt(Mu $got, Mu $expected) {
  107. + $time_after = nqp::p6box_n(pir::time__N);
  108. + my $test = !($got eq $expected);
  109. + proclaim($test, '');
  110. + $time_before = nqp::p6box_n(pir::time__N);
  111. }
  112. -multi sub isnt(Mu $got, Mu $expected) { isnt($got, $expected, ''); }
  113.  
  114. proto sub is_approx(|$) is export { * }
  115. multi sub is_approx(Mu $got, Mu $expected, $desc) {
  116. + $time_after = nqp::p6box_n(pir::time__N);
  117. my $test = ($got - $expected).abs <= 1/100000;
  118. proclaim(?$test, $desc);
  119. unless $test {
  120. @@ -106,55 +141,91 @@ multi sub is_approx(Mu $got, Mu $expected, $desc) {
  121. diag("expected: $expected");
  122. }
  123. ?$test;
  124. + $time_before = nqp::p6box_n(pir::time__N);
  125. }
  126. multi sub is_approx(Mu $got, Mu $expected) {
  127. - is_approx($got, $expected, '');
  128. + $time_after = nqp::p6box_n(pir::time__N);
  129. + my $test = ($got - $expected).abs <= 1/100000;
  130. + proclaim(?$test, '');
  131. + unless $test {
  132. + diag("got: $got");
  133. + diag("expected: $expected");
  134. + }
  135. + ?$test;
  136. + $time_before = nqp::p6box_n(pir::time__N);
  137. }
  138.  
  139. proto sub todo(|$) is export { * }
  140. multi sub todo($reason, $count) {
  141. + $time_after = nqp::p6box_n(pir::time__N);
  142. $todo_upto_test_num = $num_of_tests_run + $count;
  143. $todo_reason = '# TODO ' ~ $reason;
  144. + $time_before = nqp::p6box_n(pir::time__N);
  145. }
  146. multi sub todo($reason) {
  147. + $time_after = nqp::p6box_n(pir::time__N);
  148. $todo_upto_test_num = $num_of_tests_run + 1;
  149. $todo_reason = '# TODO ' ~ $reason;
  150. + $time_before = nqp::p6box_n(pir::time__N);
  151. }
  152.  
  153. proto sub skip(|$) is export { * }
  154. -multi sub skip() { proclaim(1, "# SKIP"); }
  155. -multi sub skip($reason) { proclaim(1, "# SKIP " ~ $reason); }
  156. +multi sub skip() {
  157. + $time_after = nqp::p6box_n(pir::time__N);
  158. + proclaim(1, "# SKIP");
  159. + $time_before = nqp::p6box_n(pir::time__N);
  160. +}
  161. +multi sub skip($reason) {
  162. + $time_after = nqp::p6box_n(pir::time__N);
  163. + proclaim(1, "# SKIP " ~ $reason);
  164. + $time_before = nqp::p6box_n(pir::time__N);
  165. +}
  166. multi sub skip($reason, $count) {
  167. + $time_after = nqp::p6box_n(pir::time__N);
  168. die "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?" if $count !~~ Numeric;
  169. my $i = 1;
  170. while $i <= $count { proclaim(1, "# SKIP " ~ $reason); $i = $i + 1; }
  171. + $time_before = nqp::p6box_n(pir::time__N);
  172. }
  173.  
  174. sub skip_rest($reason = '<unknown>') is export {
  175. + $time_after = nqp::p6box_n(pir::time__N);
  176. skip($reason, $num_of_tests_planned - $num_of_tests_run);
  177. + $time_before = nqp::p6box_n(pir::time__N);
  178. }
  179.  
  180. sub diag($message) is export {
  181. + $time_after = nqp::p6box_n(pir::time__N);
  182. # XXX No regexes yet in nom
  183. #say $message.subst(rx/^^/, '# ', :g);
  184. say "# " ~ $message;
  185. + $time_before = nqp::p6box_n(pir::time__N);
  186. }
  187.  
  188. proto sub flunk(|$) is export { * }
  189. -multi sub flunk($reason) { proclaim(0, "flunk $reason")}
  190. +multi sub flunk($reason) {
  191. + $time_after = nqp::p6box_n(pir::time__N);
  192. + proclaim(0, "flunk $reason");
  193. + $time_before = nqp::p6box_n(pir::time__N);
  194. +}
  195.  
  196. proto sub isa_ok(|$) is export { * }
  197. multi sub isa_ok(Mu $var, Mu $type) {
  198. + $time_after = nqp::p6box_n(pir::time__N);
  199. ok($var.isa($type), "The object is-a '" ~ $type.perl ~ "'")
  200. or diag('Actual type: ' ~ $var.WHAT);
  201. + $time_before = nqp::p6box_n(pir::time__N);
  202. }
  203. multi sub isa_ok(Mu $var, Mu $type, $msg) {
  204. + $time_after = nqp::p6box_n(pir::time__N);
  205. ok($var.isa($type), $msg)
  206. or diag('Actual type: ' ~ $var.WHAT);
  207. + $time_before = nqp::p6box_n(pir::time__N);
  208. }
  209.  
  210. proto sub dies_ok(|$) is export { * }
  211. multi sub dies_ok(Callable $closure, $reason) {
  212. + $time_after = nqp::p6box_n(pir::time__N);
  213. my $death = 1;
  214. my $bad_death = 0;
  215. try {
  216. @@ -169,24 +240,32 @@ multi sub dies_ok(Callable $closure, $reason) {
  217. #}
  218. }
  219. proclaim( $death && !$bad_death, $reason );
  220. + $time_before = nqp::p6box_n(pir::time__N);
  221. }
  222. multi sub dies_ok(Callable $closure) {
  223. + $time_after = nqp::p6box_n(pir::time__N);
  224. dies_ok($closure, '');
  225. + $time_before = nqp::p6box_n(pir::time__N);
  226. }
  227.  
  228. proto sub lives_ok(|$) is export { * }
  229. multi sub lives_ok(Callable $closure, $reason){
  230. + $time_after = nqp::p6box_n(pir::time__N);
  231. try {
  232. $closure();
  233. }
  234. proclaim((not defined $!), $reason);
  235. + $time_before = nqp::p6box_n(pir::time__N);
  236. }
  237. multi sub lives_ok(Callable $closure) {
  238. + $time_after = nqp::p6box_n(pir::time__N);
  239. lives_ok($closure, '');
  240. + $time_before = nqp::p6box_n(pir::time__N);
  241. }
  242.  
  243. proto sub eval_dies_ok(|$) is export { * }
  244. multi sub eval_dies_ok(Str $code, $reason) {
  245. + $time_after = nqp::p6box_n(pir::time__N);
  246. my $ee = eval_exception($code);
  247. if defined $ee {
  248. # XXX no regexes yet in nom
  249. @@ -199,22 +278,30 @@ multi sub eval_dies_ok(Str $code, $reason) {
  250. else {
  251. proclaim( 0, $reason );
  252. }
  253. + $time_before = nqp::p6box_n(pir::time__N);
  254. }
  255. multi sub eval_dies_ok(Str $code) {
  256. + $time_after = nqp::p6box_n(pir::time__N);
  257. eval_dies_ok($code, '');
  258. + $time_before = nqp::p6box_n(pir::time__N);
  259. }
  260.  
  261. proto sub eval_lives_ok(|$) is export { * }
  262. multi sub eval_lives_ok(Str $code, $reason) {
  263. + $time_after = nqp::p6box_n(pir::time__N);
  264. proclaim((not defined eval_exception($code)), $reason);
  265. + $time_before = nqp::p6box_n(pir::time__N);
  266. }
  267. multi sub eval_lives_ok(Str $code) {
  268. - eval_lives_ok($code, '');
  269. + $time_after = nqp::p6box_n(pir::time__N);
  270. + proclaim((not defined eval_exception($code)), '');
  271. + $time_before = nqp::p6box_n(pir::time__N);
  272. }
  273.  
  274. proto sub is_deeply(|$) is export { * }
  275. multi sub is_deeply(Mu $got, Mu $expected, $reason = '')
  276. {
  277. + $time_after = nqp::p6box_n(pir::time__N);
  278. my $test = _is_deeply( $got, $expected );
  279. proclaim($test, $reason);
  280. if !$test {
  281. @@ -226,6 +313,7 @@ multi sub is_deeply(Mu $got, Mu $expected, $reason = '')
  282. }
  283. }
  284. $test;
  285. + $time_before = nqp::p6box_n(pir::time__N);
  286. }
  287.  
  288. sub _is_deeply(Mu $got, Mu $expected) {
  289. @@ -242,7 +330,6 @@ sub eval_exception($code) {
  290.  
  291. sub proclaim($cond, $desc) {
  292. # exclude the time spent in proclaim from the test time
  293. - $time_after = nqp::p6box_n(pir::time__N);
  294. $num_of_tests_run = $num_of_tests_run + 1;
  295.  
  296. unless $cond {
  297. @@ -265,8 +352,6 @@ sub proclaim($cond, $desc) {
  298. # must clear this between tests
  299. if $todo_upto_test_num == $num_of_tests_run { $todo_reason = '' }
  300. $cond;
  301. - # exclude the time spent in proclaim from the test time
  302. - $time_before = nqp::p6box_n(pir::time__N);
  303. }
  304.  
  305. sub done_testing() is export {
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement