API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Sep 2nd, 2011
167
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 10.47 KB | None | 0 0
raw download clone embed print report
  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
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!