Skip to content

Commit

Permalink
Import Ovid's Test.pm with improved diagnostics.
Browse files Browse the repository at this point in the history 
Also added some type declarations to avoid accidential
dies_ok 'some_string_here' that should really have been eval_dies_ok.
That already caught some instances in the test suite.
  • Loading branch information
@moritz
moritz committed Feb 17, 2009
1 parent 13b84ef commit 842ef38
Showing 1 changed file with 46 additions and 23 deletions.
69 changes: 46 additions & 23 deletions Test.pm
View file
@@ -1,15 +1,17 @@
# Copyright (C) 2007, The Perl Foundation.
# $Id$
# $Id: Test.pm 34904 2009-01-03 23:24:38Z masak $

## 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_run = 0;
our $num_of_tests_failed = 0;
our $todo_upto_test_num = 0;
our $todo_reason = '';
our $num_of_tests_planned;
our $todo_upto_test_num = 0;
our $todo_reason = '';
our $no_plan;
our $die_on_fail;

our $*WARNINGS = 0;

Expand All @@ -26,8 +28,19 @@ sub approx ($x, $y) {
($diff < $epsilon);
}

sub plan($number_of_tests) is export() {
# you can call die_on_fail; to turn it on and die_on_fail(0) to turn it off
sub die_on_fail($fail=1) {
$die_on_fail = $fail;
}

# "plan 'no_plan';" is now "plan *;"
multi sub plan(Whatever $plan) is export() {
$no_plan = 1;
}

multi sub plan($number_of_tests) is export() {
$testing_started = 1;

$num_of_tests_planned = $number_of_tests;

say '1..' ~ $number_of_tests;
Expand Down Expand Up @@ -105,57 +118,57 @@ sub diag($message) is export() { say '# '~$message; }
multi sub flunk($reason) is export() { proclaim(0, "flunk $reason")}


multi sub isa_ok($var,$type) is export() {
multi sub isa_ok(Object $var,$type) is export() {
ok($var.isa($type), "The object is-a '$type'");
}
multi sub isa_ok($var,$type, $msg) is export() { ok($var.isa($type), $msg); }
multi sub isa_ok(Object $var,$type, $msg) is export() { ok($var.isa($type), $msg); }

multi sub dies_ok($closure, $reason) is export() {
multi sub dies_ok(Callable $closure, $reason) is export() {
try {
$closure();
}
proclaim((defined $!), $reason);
}
multi sub dies_ok($closure) is export() {
multi sub dies_ok(Callable $closure) is export() {
dies_ok($closure, '');
}

multi sub lives_ok($closure, $reason) is export() {
multi sub lives_ok(Callable $closure, $reason) is export() {
try {
$closure();
}
proclaim((not defined $!), $reason);
}
multi sub lives_ok($closure) is export() {
multi sub lives_ok(Callable $closure) is export() {
lives_ok($closure, '');
}

multi sub eval_dies_ok($code, $reason) is export() {
multi sub eval_dies_ok(Str $code, $reason) is export() {
proclaim((defined eval_exception($code)), $reason);
}
multi sub eval_dies_ok($code) is export() {
multi sub eval_dies_ok(Str $code) is export() {
eval_dies_ok($code, '');
}

multi sub eval_lives_ok($code, $reason) is export() {
multi sub eval_lives_ok(Str $code, $reason) is export() {
proclaim((not defined eval_exception($code)), $reason);
}
multi sub eval_lives_ok($code) is export() {
multi sub eval_lives_ok(Str $code) is export() {
eval_lives_ok($code, '');
}


multi sub is_deeply($this, $that, $reason) {
multi sub is_deeply(Object $this, Object $that, $reason) {
my $val = _is_deeply( $this, $that );
proclaim($val, $reason);
}

multi sub is_deeply($this, $that) {
multi sub is_deeply(Object $this, Object $that) {
my $val = _is_deeply( $this, $that );
proclaim($val, '');
}

sub _is_deeply( $this, $that) {
sub _is_deeply(Object $this, Object $that) {

if $this ~~ List && $that ~~ List {
return if +$this.values != +$that.values;
Expand Down Expand Up @@ -195,14 +208,10 @@ sub eval_exception($code) {
$eval_exception // $!;
}

sub proclaim(Object $cond, $desc) {
sub proclaim($cond, $desc) {
$testing_started = 1;
$num_of_tests_run = $num_of_tests_run + 1;

if $cond.HOW().isa($cond, Junction) {
warn("Junction passed to proclaim");
}

unless $cond {
print "not ";
$num_of_tests_failed = $num_of_tests_failed + 1
Expand All @@ -213,6 +222,12 @@ sub proclaim(Object $cond, $desc) {
print $todo_reason;
}
print "\n";

if !$cond && $die_on_fail && !$todo_reason {
die "Test failed. Stopping test";
}
# must clear this between tests
$todo_reason = '';
}

END {
Expand All @@ -222,6 +237,12 @@ END {
our $num_of_tests_planned;
our $num_of_tests_run;
our $num_of_tests_failed;
our $no_plan;

if $no_plan {
$num_of_tests_planned = $num_of_tests_run;
say "1..$num_of_tests_planned";
}

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");
Expand All @@ -230,3 +251,5 @@ END {
diag("Looks like you failed $num_of_tests_failed tests of $num_of_tests_run");
}
}

# vim: ft=perl6

0 comments on commit 842ef38

Please sign in to comment.