# New Ticket Created by Vasily Chekalkin # Please include the string: [perl #55438] # in the subject line of all future correspondence about this issue. # <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=55438 >
Hello. There is patched Test.pm which allows unittest it. Provide method to override 'proclaim()' from external program to check it invocation. Also attached 'test.t' for it. I just don't know best place for this test. And whole Test.pm just in case :) -- Bacek.
diff --git a/languages/perl6/Test.pm b/languages/perl6/Test.pm index 5cb04ae..e113af7 100644 --- a/languages/perl6/Test.pm +++ b/languages/perl6/Test.pm @@ -14,9 +14,16 @@ our $todo_reason = ''; # for running the test suite multiple times in the same process our $testing_started; +# for unittesting of Test.pm we override 'proclaim' +our &proclaim := &real_proclaim; + +sub set_proclaim($proc) { + &proclaim := $proc; +} ## test functions + # Compare numeric values with approximation sub approx ($x, $y) { my $epsilon = 0.00001; @@ -33,14 +40,14 @@ sub plan($number_of_tests) { multi sub ok($cond, $desc) { - proclaim($cond, $desc); + &proclaim($cond, $desc); } multi sub ok($cond) { ok($cond, ''); } multi sub nok($cond, $desc) { - proclaim(!$cond, $desc); + &proclaim(!$cond, $desc); } multi sub nok($cond) { nok(!$cond, ''); } @@ -48,7 +55,7 @@ multi sub nok($cond) { nok(!$cond, ''); } multi sub is($got, $expected, $desc) { my $test = $got eq $expected; - proclaim($test, $desc); + &proclaim($test, $desc); } multi sub is($got, $expected) { is($got, $expected, ''); } @@ -56,14 +63,14 @@ multi sub is($got, $expected) { is($got, $expected, ''); } multi sub isnt($got, $expected, $desc) { my $test = !($got eq $expected); - proclaim($test, $desc); + &proclaim($test, $desc); } multi sub isnt($got, $expected) { isnt($got, $expected, ''); } multi sub is_approx($got, $expected, $desc) { my $test = abs($got - $expected) <= 0.00001; - proclaim($test, $desc); + &proclaim($test, $desc); } multi sub is_approx($got, $expected) { is_approx($got, $expected, ''); } @@ -78,11 +85,11 @@ multi sub todo($reason) { $todo_reason = '# TODO ' ~ $reason; } -multi sub skip() { proclaim(1, "# SKIP"); } -multi sub skip($reason) { proclaim(1, "# SKIP " ~ $reason); } +multi sub skip() { &proclaim(1, "# SKIP"); } +multi sub skip($reason) { &proclaim(1, "# SKIP " ~ $reason); } multi sub skip($count, $reason) { for 1..$count { - proclaim(1, "# SKIP " ~ $reason); + &proclaim(1, "# SKIP " ~ $reason); } } @@ -97,16 +104,20 @@ multi sub skip_rest($reason) { sub diag($message) { say '# '~$message; } -multi sub flunk($reason) { proclaim(0, "flunk $reason")} +multi sub flunk($reason) { &proclaim(0, "flunk $reason")} sub isa_ok($var,$type) { ok($var.isa($type), "The object is-a '$type'"); } multi sub dies_ok($closure, $reason) { + our $died = 1; try { $closure(); + $died = 0; } - proclaim((defined $!), $reason); + # This line is to avoid bug in rakudo. We'll remove it + $died = 0 + $died; + &proclaim($died, $reason); } multi sub dies_ok($closure) { dies_ok($closure, ''); @@ -115,22 +126,24 @@ multi sub dies_ok($closure) { multi sub lives_ok($closure, $reason) { try { $closure(); + &proclaim(1, $reason); } - proclaim((not defined $!), $reason); } multi sub lives_ok($closure) { lives_ok($closure, ''); } multi sub eval_dies_ok($code, $reason) { - proclaim((defined eval_exception($code)), $reason); + eval($code); + &proclaim(defined($!), $reason); } multi sub eval_dies_ok($code) { eval_dies_ok($code, ''); } multi sub eval_lives_ok($code, $reason) { - proclaim((not defined eval_exception($code)), $reason); + eval($code); + &proclaim(!(defined $!), $reason); } multi sub eval_lives_ok($code) { eval_lives_ok($code, ''); @@ -139,13 +152,7 @@ multi sub eval_lives_ok($code) { ## 'private' subs -sub eval_exception($code) { - my $eval_exception; - try { eval ($code); $eval_exception = $! } - $eval_exception // $!; -} - -sub proclaim($cond, $desc) { +sub real_proclaim($cond, $desc) { $testing_started = 1; $num_of_tests_run = $num_of_tests_run + 1;
# Copyright (C) 2007, The Perl Foundation. # $Id$ ## This is a temporary Test.pm to get us started until we get pugs's Test.pm ## working. It's shamelessly stolen & adapted from MiniPerl6 in the pugs repo. # globals to keep track of our tests our $num_of_tests_run = 0; our $num_of_tests_failed = 0; our $num_of_tests_planned; our $todo_upto_test_num = 0; our $todo_reason = ''; # for running the test suite multiple times in the same process our $testing_started; # for unittesting of Test.pm we override 'proclaim' our &proclaim := &real_proclaim; sub set_proclaim($proc) { &proclaim := $proc; } ## test functions # Compare numeric values with approximation sub approx ($x, $y) { my $epsilon = 0.00001; my $diff = abs($x - $y); ($diff < $epsilon); } sub plan($number_of_tests) { $testing_started = 1; $num_of_tests_planned = $number_of_tests; say '1..' ~ $number_of_tests; } multi sub ok($cond, $desc) { &proclaim($cond, $desc); } multi sub ok($cond) { ok($cond, ''); } multi sub nok($cond, $desc) { &proclaim(!$cond, $desc); } multi sub nok($cond) { nok(!$cond, ''); } multi sub is($got, $expected, $desc) { my $test = $got eq $expected; &proclaim($test, $desc); } multi sub is($got, $expected) { is($got, $expected, ''); } multi sub isnt($got, $expected, $desc) { my $test = !($got eq $expected); &proclaim($test, $desc); } multi sub isnt($got, $expected) { isnt($got, $expected, ''); } multi sub is_approx($got, $expected, $desc) { my $test = abs($got - $expected) <= 0.00001; &proclaim($test, $desc); } multi sub is_approx($got, $expected) { is_approx($got, $expected, ''); } multi sub todo($reason, $count) { $todo_upto_test_num = $num_of_tests_run + $count; $todo_reason = '# TODO ' ~ $reason; } multi sub todo($reason) { $todo_upto_test_num = $num_of_tests_run + 1; $todo_reason = '# TODO ' ~ $reason; } multi sub skip() { &proclaim(1, "# SKIP"); } multi sub skip($reason) { &proclaim(1, "# SKIP " ~ $reason); } multi sub skip($count, $reason) { for 1..$count { &proclaim(1, "# SKIP " ~ $reason); } } multi sub skip_rest() { skip($num_of_tests_planned - $num_of_tests_run, ""); } multi sub skip_rest($reason) { skip($num_of_tests_planned - $num_of_tests_run, $reason); } sub diag($message) { say '# '~$message; } multi sub flunk($reason) { &proclaim(0, "flunk $reason")} sub isa_ok($var,$type) { ok($var.isa($type), "The object is-a '$type'"); } multi sub dies_ok($closure, $reason) { our $died = 1; try { $closure(); $died = 0; } # This line is to avoid bug in rakudo. We'll remove it $died = 0 + $died; &proclaim($died, $reason); } multi sub dies_ok($closure) { dies_ok($closure, ''); } multi sub lives_ok($closure, $reason) { try { $closure(); &proclaim(1, $reason); } } multi sub lives_ok($closure) { lives_ok($closure, ''); } multi sub eval_dies_ok($code, $reason) { eval($code); &proclaim(defined($!), $reason); } multi sub eval_dies_ok($code) { eval_dies_ok($code, ''); } multi sub eval_lives_ok($code, $reason) { eval($code); &proclaim(!(defined $!), $reason); } multi sub eval_lives_ok($code) { eval_lives_ok($code, ''); } ## 'private' subs sub real_proclaim($cond, $desc) { $testing_started = 1; $num_of_tests_run = $num_of_tests_run + 1; unless $cond { print "not "; $num_of_tests_failed = $num_of_tests_failed + 1 unless $num_of_tests_run <= $todo_upto_test_num; } print "ok ", $num_of_tests_run, " - ", $desc; if $todo_reason and $num_of_tests_run <= $todo_upto_test_num { print $todo_reason; } print "\n"; } END { # until END blocks can access compile-time symbol tables of outer scopes, # we need these declarations our $testing_started; our $num_of_tests_planned; our $num_of_tests_run; our $num_of_tests_failed; if ($testing_started and $num_of_tests_planned != $num_of_tests_run) { ##Wrong quantity of tests diag("Looks like you planned $num_of_tests_planned tests, but ran $num_of_tests_run"); } if ($testing_started and $num_of_tests_failed) { diag("Looks like you failed $num_of_tests_failed tests of $num_of_tests_run"); } }