From: Joshua Pritikin <joshua.pritikin@db.com>
Date: Sat, 21 Feb 1998 14:17:09 +0000 (-0500)
Subject: improved Test.pm
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3238f5fe6293a28fd91d4f803f3a2df14d3a9498;p=p5sagit%2Fp5-mst-13.2.git
improved Test.pm
p4raw-id: //depot/perl@580
---
diff --git a/lib/Test.pm b/lib/Test.pm
index 7e79da2..b10d104 100644
--- a/lib/Test.pm
+++ b/lib/Test.pm
@@ -2,18 +2,19 @@ use strict;
package Test;
use Test::Harness 1.1601 ();
use Carp;
-use vars qw($VERSION @ISA @EXPORT $ntest %todo);
-$VERSION = '0.06';
+use vars qw($VERSION @ISA @EXPORT $ntest %todo %history $TestLevel);
+$VERSION = '0.08';
require Exporter;
@ISA=('Exporter');
@EXPORT= qw(&plan &ok &skip $ntest);
+$TestLevel = 0; # how many extra stack frames to skip
$|=1;
#$^W=1; ?
$ntest=1;
-# Use of this variable is strongly discouraged. It is set
-# exclusively for test coverage analyzers.
+# Use of this variable is strongly discouraged. It is set mainly to
+# help test coverage analyzers know which test is running.
$ENV{REGRESSION_TEST} = $0;
sub plan {
@@ -34,33 +35,81 @@ sub plan {
}
}
+sub to_value {
+ my ($v) = @_;
+ (ref $v or '') eq 'CODE' ? $v->() : $v;
+}
+
+# prototypes are not used for maximum flexibility
+
+# STDERR is NOT used for diagnostic output that should be fixed before
+# the module is released.
+
sub ok {
- my ($ok, $guess) = @_;
- carp "(this is ok $ntest)" if defined $guess && $guess != $ntest;
- $ok = $ok->() if (ref $ok or '') eq 'CODE';
- if ($ok) {
+ my ($pkg,$file,$line) = caller($TestLevel);
+ my $repetition = ++$history{"$file:$line"};
+ my $context = ("$file at line $line".
+ ($repetition > 1 ? " (\#$repetition)" : ''));
+ my $ok=0;
+
+ if (@_ == 0) {
+ print "not ok $ntest\n";
+ print "# test $context: DOESN'T TEST ANYTHING!\n";
+ } else {
+ my $result = to_value(shift);
+ my ($expected,$diag);
+ if (@_ == 0) {
+ $ok = $result;
+ } else {
+ $expected = to_value(shift);
+ $ok = $result eq $expected;
+ }
if ($todo{$ntest}) {
- print("ok $ntest # Wow!\n");
+ if ($ok) {
+ print "ok $ntest # Wow!\n";
+ } else {
+ $diag = to_value(shift) if @_;
+ if (!$diag) {
+ print "not ok $ntest # (failure expected)\n";
+ } else {
+ print "not ok $ntest # (failure expected: $diag)\n";
+ }
+ }
} else {
- print("ok $ntest # (failure expected)\n");
+ print "not " if !$ok;
+ print "ok $ntest\n";
+
+ if (!$ok) {
+ $diag = to_value(shift) if @_;
+ if (!defined $expected) {
+ if (!$diag) {
+ print STDERR "# Failed $context\n";
+ } else {
+ print STDERR "# Failed $context: $diag\n";
+ }
+ } else {
+ print STDERR "# Got: '$result' ($context)\n";
+ if (!$diag) {
+ print STDERR "# Expected: '$expected'\n";
+ } else {
+ print STDERR "# Expected: '$expected' ($diag)\n";
+ }
+ }
+ }
}
- } else {
- print("not ok $ntest\n");
}
++ $ntest;
$ok;
}
sub skip {
- my ($toskip, $ok, $guess) = @_;
- carp "(this is skip $ntest)" if defined $guess && $guess != $ntest;
- $toskip = $toskip->() if (ref $toskip or '') eq 'CODE';
- if ($toskip) {
+ if (to_value(shift)) {
print "ok $ntest # skip\n";
++ $ntest;
1;
} else {
- ok($ok);
+ local($TestLevel) += 1; #ignore this stack frame
+ ok(@_);
}
}
@@ -75,42 +124,54 @@ __END__
use strict;
use Test;
- BEGIN { plan tests => 5, todo => [3,4] }
+ BEGIN { plan tests => 12, todo => [3,4] }
+
+ ok(0); # failure
+ ok(1); # success
+
+ ok(0); # ok, expected failure (see todo list, above)
+ ok(1); # surprise success!
+
+ ok(0,1); # failure: '0' ne '1'
+ ok('broke','fixed'); # failure: 'broke' ne 'fixed'
+ ok('fixed','fixed'); # success: 'fixed' eq 'fixed'
- ok(0); #failure
- ok(1); #success
+ ok(sub { 1+1 }, 2); # success: '2' eq '2'
+ ok(sub { 1+1 }, 3); # failure: '2' ne '3'
+ ok(0, int(rand(2)); # (just kidding! :-)
- ok(0); #ok, expected failure (see todo above)
- ok(1); #surprise success!
+ my @list = (0,0);
+ ok(scalar(@list), 3, "\@list=".join(',',@list)); #extra diagnostics
- skip($feature_is_missing, sub {...}); #do platform specific test
+ skip($feature_is_missing, ...); #do platform specific test
=head1 DESCRIPTION
-Test::Harness expects to see particular output when it executes test
-scripts. This module tries to make conforming just a little bit
-easier (and less error prone).
+Test::Harness expects to see particular output when it executes tests.
+This module aims to make writing proper test scripts just a little bit
+easier (and less error prone :-).
-=head1 TEST CATEGORIES
+=head1 TEST TYPES
=over 4
=item * NORMAL TESTS
-These tests are expected to succeed. If they don't, something is
-wrong!
+These tests are expected to succeed. If they don't, something's
+screwed up!
=item * SKIPPED TESTS
-C<skip> should be used to skip tests for which a platform specific
-feature isn't available.
+Skip tests need a platform specific feature that might or might not be
+available. The first argument should evaluate to true if the required
+feature is NOT available. After the first argument, skip tests work
+exactly the same way as do normal tests.
=item * TODO TESTS
-TODO tests are designed for the purpose of maintaining an executable
-TODO list. These tests are expected NOT to succeed (otherwise the
-feature they test would be on the new feature list, not the TODO
-list).
+TODO tests are designed for maintaining an executable TODO list.
+These tests are expected NOT to succeed (otherwise the feature they
+test would be on the new feature list, not the TODO list).
Packages should NOT be released with successful TODO tests. As soon
as a TODO test starts working, it should be promoted to a normal test