Better Test.pm diagnotics [PATCH]
Gisle Aas
failures. That makes it possible to see what's wrong with binary or
Unicode results. The patch also adds support for the PERL_TEST_DIFF
environment variable. If set, then Test will run diff on unexpected
multiline output for you.
The patch is relative to Test v1.24.
--Gisle
Index: main/Apps/Gecko/src/Core/lib/Test.pm
--- main/Apps/Gecko/src/Core/lib/Test.pm.~1~ Tue Apr 13 11:03:45 2004
+++ main/Apps/Gecko/src/Core/lib/Test.pm Tue Apr 13 11:03:45 2004
@@ -7,7 +7,7 @@
use Carp;
use vars (qw($VERSION @ISA @EXPORT @EXPORT_OK $ntest $TestLevel), #public-ish
- qw($TESTOUT $TESTERR %Program_Lines
+ qw($TESTOUT $TESTERR %Program_Lines $told_about_diff
$ONFAIL %todo %history $planned @FAILDETAIL) #private-ish
);
@@ -400,22 +400,54 @@
}
} else {
my $prefix = "Test $ntest";
- print $TESTERR "# $prefix got: ".
- (defined $result? "'$result'":'<UNDEF>')." ($context)\n";
+ print $TESTERR "# $prefix got: " . _quote($result) .
+ " ($context)\n";
$prefix = ' ' x (length($prefix) - 5);
- if (defined $regex) {
- $expected = 'qr{'.$regex.'}';
- }
- elsif (defined $expected) {
- $expected = "'$expected'";
- }
- else {
- $expected = '<UNDEF>';
- }
+ my $expected_quoted = (defined $regex) ? 'qr{'.$regex.'}'
+ : _quote($expected);
if (!$diag) {
- print $TESTERR "# $prefix Expected: $expected\n";
+ print $TESTERR "# $prefix Expected: $expected_quoted\n";
} else {
- print $TESTERR "# $prefix Expected: $expected ($diag)\n";
+ print $TESTERR "# $prefix Expected: $expected_quoted ($diag)\n";
+ }
+
+ if (($expected =~ tr/\n//) > 2) {
+ # Multiline, try to show diff
+ if (my $diff = $ENV{PERL_TEST_DIFF}) {
+ require File::Temp;
+ my($got_fh, $got_filename) = File::Temp::tempfile("test-got-XXXXX");
+ my($exp_fh, $exp_filename) = File::Temp::tempfile("test-exp-XXXXX");
+ if ($got_fh && $exp_fh) {
+ print $got_fh $result;
+ print $exp_fh $expected;
+ if (close($got_fh) && close($exp_fh)) {
+ my $diff_cmd = "$diff $exp_filename $got_filename";
+ print $TESTERR "#\n# $prefix $diff_cmd\n";
+ if (open(DIFF, "$diff_cmd |")) {
+ local $_;
+ while (<DIFF>) {
+ print $TESTERR "# $prefix $_";
+ }
+ close(DIFF);
+ }
+ else {
+ warn "Can't run diff: $!";
+ }
+ }
+ else {
+ warn "Can't write to tempfiles: $!";
+ }
+ unlink($got_filename);
+ unlink($exp_filename);
+ }
+ else {
+ warn "Can't get tempfiles";
+ }
+ }
+ else {
+ print $TESTERR "# $prefix (Set the PERL_TEST_DIFF environment variable to run a diff program on the output)\n"
+ unless $told_about_diff++;
+ }
}
}
@@ -438,6 +470,24 @@
$ok;
}
+sub _quote {
+ my $str = shift;
+ return "<UNDEF>" unless defined $str;
+ $str =~ s/\\/\\\\/g;
+ $str =~ s/"/\\"/g;
+ $str =~ s/\a/\\a/g;
+ $str =~ s/[\b]/\\b/g;
+ $str =~ s/\e/\\e/g;
+ $str =~ s/\f/\\f/g;
+ $str =~ s/\n/\\n/g;
+ $str =~ s/\r/\\r/g;
+ $str =~ s/\t/\\t/g;
+ $str =~ s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
+ $str =~ s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
+ $str =~ s/([^\0-\176])/sprintf('\\x{%X}',ord($1))/eg;
+ return qq("$str");
+}
+
=item C<skip(I<skip_if_true>, I<args...>)>
This is used for tests that under some conditions can be skipped. It's
@@ -714,6 +764,12 @@
=back
+=head1 ENVIRONMENT
+
+If C<PERL_TEST_DIFF> environment variable is set, it will be used as a
+command to compare unexpected multiline results. If you have GNU diff
+you might want to set its value as C<diff -u>.
+
=head1 NOTE
A past developer of this module once said that it was no longer being
End of Patch.
sch...@pobox.com
> The patch also adds support for the PERL_TEST_DIFF environment variable.
> If set, then Test will run diff on unexpected multiline output for you.
Perhaps it should simply try to use Text::Diff if installed. That would
at least have a chance of working cross-platform.
--
Michael G Schwern <sch...@pobox.com> http://www.pobox.com/~schwern/
Perl Quality Assurance <per...@perl.org> Kwalitee Is Job One
Barrie Slaymaker
> On Tue, Apr 13, 2004 at 02:11:54AM -0700, Gisle Aas wrote:
> > The patch also adds support for the PERL_TEST_DIFF environment variable.
> > If set, then Test will run diff on unexpected multiline output for you.
>
> Perhaps it should simply try to use Text::Diff if installed. That would
> at least have a chance of working cross-platform.
There's also Test::Differences if you want that functionality hardcoded
in.
- Barrie
Joseph G. Tchamitchian
Gisle Aas
> On Tue, Apr 13, 2004 at 02:11:54AM -0700, Gisle Aas wrote:
> > The patch also adds support for the PERL_TEST_DIFF environment variable.
> > If set, then Test will run diff on unexpected multiline output for you.
>
> Perhaps it should simply try to use Text::Diff if installed. That would
> at least have a chance of working cross-platform.
Invoking an external program to compare two files should work on all
platforms. What do you expect will break? The original diff program
itself is also available on most platforms, even though it does not
come with Windows out-of-the-box. If you have Text::Diff installed
you could just set PERL_TEST_DIFF to be:
PERL_TEST_DIFF="perl -MText::Diff -e 'print diff(@ARGV)'"
I did plan adding support for comparing the result directly with
Algorithm::Diff, but for now PERL_TEST_DIFF did the job for me. I
think that enhancement can come later.
Regards,
Gisle
Sean M. Burke
>Invoking an external program to compare two files should work on all
>platforms. What do you expect will break?
Well, I seem to remember that under MacPerl, perl can't invoke itself.
Anyway, I love the idea of diffing (and escaping!) the gotten and expected
data for when ok() fails; but I'd really be a whole lot happier if this
would avoid using an external process. Can someone make it use Text::Diff
or Algorithm::Diff or whatever, pretty pretty please?
(I guess that'd mean that whichever would have to become core, but I doubt
there'd be an objection to either.)
--
Sean M. Burke http://search.cpan.org/~sburke/
Gisle Aas
> Anyway, I love the idea of diffing (and escaping!) the gotten and
> expected data for when ok() fails; but I'd really be a whole lot
> happier if this would avoid using an external process. Can someone
> make it use Text::Diff or Algorithm::Diff or whatever, pretty pretty
> please?
>
> (I guess that'd mean that whichever would have to become core, but I
> doubt there'd be an objection to either.)
There seems to be a lot of resistance to adding more modules to the
core at this point.
--Gisle
Fergal Daly
> Anyway, I love the idea of diffing (and escaping!) the gotten and expected
> data for when ok() fails; but I'd really be a whole lot happier if this
> would avoid using an external process. Can someone make it use Text::Diff
> or Algorithm::Diff or whatever, pretty pretty please?
>
> (I guess that'd mean that whichever would have to become core, but I doubt
> there'd be an objection to either.)
rather than adding more to the core (and diffing in Perl is something very
few people will be doing) why not do something like
my $has_diff = eval { require Text::Diff };
....
sub ok
{
...
if ($has_diff)
{
# nice diagnostics
}
else
{
# plain diagnostics
}
}
F
Fergal Daly
> > rather than adding more to the core (and diffing in Perl is something very
> > few people will be doing) why not do something like
>
> diagnostics will make me install the required module instantly (if it does not
> depend on anything else that I don't have)
I was about to say "me too" but then when I think about it, if someone
actually needs diff to track down their problem then they could probably do
with some more granular tests. Of course there are occasions where this is
not true but I'd guess that the vast majority of ok() tests are comparing
single line strings and diff is no help here.
I'd also guess that the vast majority of Perl users have no interest in test
diagnostics at all (unfortunately).
So I think very few people will ever see the diff output, so making a
requirement seems a bit heavy.
By the way, it'd be nice if whatever diff stuff goes into Test also went
into Test::More,
F
H.Merijn Brand
> On Thu, Apr 15, 2004 at 01:26:34AM -0800, Sean M. Burke wrote:
> > Anyway, I love the idea of diffing (and escaping!) the gotten and expected
> > data for when ok() fails; but I'd really be a whole lot happier if this
> > would avoid using an external process. Can someone make it use Text::Diff
> > or Algorithm::Diff or whatever, pretty pretty please?
> >
> > (I guess that'd mean that whichever would have to become core, but I doubt
> > there'd be an objection to either.)
>
> rather than adding more to the core (and diffing in Perl is something very
> few people will be doing) why not do something like
Indeed, I've never used either Text::Diff or Algorithm::Diff, but getting good
diagnostics will make me install the required module instantly (if it does not
depend on anything else that I don't have)
> my $has_diff = eval { require Text::Diff };
> ....
>
> sub ok
> {
> ...
> if ($has_diff)
> {
> # nice diagnostics
> }
> else
> {
> # plain diagnostics
> }
> }
>
> F
--
H.Merijn Brand Amsterdam Perl Mongers (http://amsterdam.pm.org/)
using perl-5.6.1, 5.8.3, & 5.9.x, and 809 on HP-UX 10.20 & 11.00, 11i,
AIX 4.3, SuSE 9.0, and Win2k. http://www.cmve.net/~merijn/
http://archives.develooper.com/daily...@perl.org/ per...@perl.org
send smoke reports to: smokers...@perl.org, QA: http://qa.perl.org
H.Merijn Brand
> On Thu, Apr 15, 2004 at 02:09:56PM +0200, H.Merijn Brand wrote:
> > > rather than adding more to the core (and diffing in Perl is something very
> > > few people will be doing) why not do something like
> >
> > Indeed, I've never used either Text::Diff or Algorithm::Diff, but getting good
> > diagnostics will make me install the required module instantly (if it does not
> > depend on anything else that I don't have)
>
> I was about to say "me too" but then when I think about it, if someone
> actually needs diff to track down their problem then they could probably do
> with some more granular tests. Of course there are occasions where this is
> not true but I'd guess that the vast majority of ok() tests are comparing
I don't consider myself amongst the vast majority, but I agree
> single line strings and diff is no help here.
>
> I'd also guess that the vast majority of Perl users have no interest in test
> diagnostics at all (unfortunately).
indeed. but smoke helps. and if we ask users about the log files, and these
already contain nice readable diff's, that would help in understanding the
problems more quickly
> So I think very few people will ever see the diff output, so making a
> requirement seems a bit heavy.
True. I didn't suggest to make them core either, but just stated *my* opinion
> By the way, it'd be nice if whatever diff stuff goes into Test also went
> into Test::More,
Sure
Barrie Slaymaker
> On Thu, Apr 15, 2004 at 02:09:56PM +0200, H.Merijn Brand wrote:
> > > rather than adding more to the core (and diffing in Perl is something very
> > > few people will be doing) why not do something like
> >
> > Indeed, I've never used either Text::Diff or Algorithm::Diff, but getting good
> > diagnostics will make me install the required module instantly (if it does not
> > depend on anything else that I don't have)
>
> I was about to say "me too" but then when I think about it, if someone
> actually needs diff to track down their problem then they could probably do
> with some more granular tests.
I wrote Test::Differences because I need to diff output from things that
return multiline strings, output files, or data structures (which
Test::Differences can dump to string). So obviously, I disagree with
that.
Also, in many cases a side-by-side display works better than over/under,
and it's sometimes key to see the difference between space and tab or to
see if there is trailing whitespace (including \r\n vs. \n) causing a
difference.
I don't think Test::Differences should go in to the core, but I do think
that a better presentation of multiline strings and data structure
differences is very convenient for the test writer and
developer-cum-test-user :).
> I'd also guess that the vast majority of Perl users have no interest in test
> diagnostics at all (unfortunately).
It's the developers that need it, not the users.
> By the way, it'd be nice if whatever diff stuff goes into Test also went
> into Test::More,
- Barrie
Fergal Daly
> > I was about to say "me too" but then when I think about it, if someone
> > actually needs diff to track down their problem then they could probably do
> > with some more granular tests.
>
> I wrote Test::Differences because I need to diff output from things that
> return multiline strings, output files, or data structures (which
> Test::Differences can dump to string). So obviously, I disagree with
> that.
I wasn't saying there's never a need for it, I was just saying that, for
example, when the final output of something is a big multiline string then
you might be better off testing things earlier in the process before
everything gets joined together into a string. Sometimes that's not possible
and sometimes you've already done that and the final output differs anyway
so it's definitely useful to have.
> Also, in many cases a side-by-side display works better than over/under,
> and it's sometimes key to see the difference between space and tab or to
> see if there is trailing whitespace (including \r\n vs. \n) causing a
> difference.
Absolutely.
> > I'd also guess that the vast majority of Perl users have no interest in test
> > diagnostics at all (unfortunately).
>
> It's the developers that need it, not the users.
Of all the installed Perl cores, how many of them will benefit from this,
how much will they benefit?
vs
How bad is adding another module to core?
I'm presuming that this is the metric that is used to decide whether
something is worth adding.
My original point was that we can add the feature for those who want it
without adding anything to the core, which seems to be a win win,
F
Yves Orton
> it use Text::Diff
> > > or Algorithm::Diff or whatever, pretty pretty please?
> > >
> > > (I guess that'd mean that whichever would have to become
> core, but I doubt
> > > there'd be an objection to either.)
> >
> something very
> > few people will be doing) why not do something like
>
> Indeed, I've never used either Text::Diff or Algorithm::Diff,
> but getting good
> diagnostics will make me install the required module
> instantly (if it does not
> depend on anything else that I don't have)
Lots of modules test suits would benefit from Algorithm::Diff being around
in core. FWIW I personally would vote that it be included. And as a matter
of fact in at least two modules I have written I have had to prereq
Algorithm::Diff just for the test suite. Were it included I think it would
be used an awful lot. And if it does get included please make sure its
Algorithm::Diff and not one of the others. Having access to Traverse
Sequences is pretty important.
yves
Sean M. Burke
>my $has_diff = eval { require Text::Diff };
> if ($has_diff)
> {
> # nice diagnostics
> }
> else
> {
> # plain diagnostics
> }
Sounds good to me! Someone flesh out the code into a full patch and I'll
take it!
Gisle Aas
> At 01:42 AM 2004-04-15, Fergal Daly wrote:
> >my $has_diff = eval { require Text::Diff };
> >...
> > if ($has_diff)
> > {
> > # nice diagnostics
> > }
> > else
> > {
> > # plain diagnostics
> > }
>
> Sounds good to me! Someone flesh out the code into a full patch and
> I'll take it!
I personally like to use PERL_TEST_DIFF so here is a patch that does
both. I hope that might make everybody happy. This is sample output:
[gisle@ask Test]$ chmod 0 /local/perl/ap-redhat9-90779/lib/site_perl/5.8.3/Algorithm/Diff.pm
[gisle@ask Test]$ perl -Ilib xxx.pl
1..1
# Running under perl version 5.008003 for linux
# Current time local: Tue Apr 20 11:55:39 2004
# Current time GMT: Tue Apr 20 09:55:39 2004
# Using Test.pm version 1.24
not ok 1
# Test 1 got: "a\nb\ncc\ndd\ne\nf\ng\nh\n" (xxx.pl at line 5)
# Expected: "a\na\nb\nc\nd\ne\n"
# (Install the Algorithm::Diff module to have differences in multiline
# output explained. You might also set the PERL_TEST_DIFF environment
# variable to run a diff program on the output.)
# xxx.pl line 5 is: ok(<<EOT, <<EOT);
[gisle@ask Test]$ PERL_TEST_DIFF="diff -u0" perl -Ilib xxx.pl
1..1
# Running under perl version 5.008003 for linux
# Current time local: Tue Apr 20 11:55:46 2004
# Current time GMT: Tue Apr 20 09:55:46 2004
# Using Test.pm version 1.24
not ok 1
# Test 1 got: "a\nb\ncc\ndd\ne\nf\ng\nh\n" (xxx.pl at line 5)
# Expected: "a\na\nb\nc\nd\ne\n"
#
# diff -u0 test-exp-EPFQH test-got-SyOiV
# --- test-exp-EPFQH 2004-04-20 11:55:46.000000000 +0200
# +++ test-got-SyOiV 2004-04-20 11:55:46.000000000 +0200
# @@ -2 +1,0 @@
# -a
# @@ -4,2 +3,2 @@
# -c
# -d
# +cc
# +dd
# @@ -6,0 +6,3 @@
# +f
# +g
# +h
# xxx.pl line 5 is: ok(<<EOT, <<EOT);
[gisle@ask Test]$ chmod 0444 /local/perl/ap-redhat9-90779/lib/site_perl/5.8.3/Algorithm/Diff.pm
[gisle@ask Test]$ perl -Ilib xxx.pl
1..10
# Running under perl version 5.008003 for linux
# Current time local: Tue Apr 20 11:56:08 2004
# Current time GMT: Tue Apr 20 09:56:08 2004
# Using Test.pm version 1.24
not ok 1
# Test 1 got: "a\nb\ncc\ndd\ne\nf\ng\nh\n" (xxx.pl at line 5)
# Expected: "a\na\nb\nc\nd\ne\n"
# Line 2 is missing:
# - "a\n"
# Lines 3-4 are changed:
# - "c\n"
# + "cc\n"
# - "d\n"
# + "dd\n"
# Got 3 extra lines at line 6:
# + "f\n"
# + "g\n"
# + "h\n"
# xxx.pl line 5 is: ok(<<EOT, <<EOT);
And this is the revised patch:
==== //depot/users/gisle/hacks/Test/lib/Test.pm#1 - /home/gisle/hacks/Test/lib/Test.pm ====
Index: users/gisle/hacks/Test/lib/Test.pm
--- users/gisle/hacks/Test/lib/Test.pm.~1~ Tue Apr 20 12:10:20 2004
+++ users/gisle/hacks/Test/lib/Test.pm Tue Apr 20 12:10:20 2004
@@ -7,7 +7,7 @@
use Carp;
use vars (qw($VERSION @ISA @EXPORT @EXPORT_OK $ntest $TestLevel), #public-ish
- qw($TESTOUT $TESTERR %Program_Lines
+ qw($TESTOUT $TESTERR %Program_Lines $told_about_diff
$ONFAIL %todo %history $planned @FAILDETAIL) #private-ish
);
@@ -400,22 +400,130 @@
+ if (defined($expected) && ($expected =~ tr/\n//) > 2) {
+ # Multiline, try to show diff
+ my $diff = $ENV{PERL_TEST_DIFF};
+ if ($diff) {
+ elsif (eval { require Algorithm::Diff }) {
+ my @got = split(/^/, $result);
+ my @exp = split(/^/, $expected);
+
+ my $diff_kind;
+ my @diff_lines;
+
+ my $diff_flush = sub {
+ return unless $diff_kind;
+
+ my $lines = @diff_lines;
+ my $s = $lines == 1 ? "" : "s";
+ my $first_line = $diff_lines[0][0] + 1;
+
+ print $TESTERR "# $prefix ";
+ if ($diff_kind eq "GOT") {
+ print $TESTERR "Got $lines extra line$s at line $first_line:\n";
+ for my $i (@diff_lines) {
+ print $TESTERR "# $prefix + " . _quote($got[$i->[0]]) . "\n";
+ }
+ }
+ elsif ($diff_kind eq "EXP") {
+ if ($lines > 1) {
+ my $last_line = $diff_lines[-1][0] + 1;
+ print $TESTERR "Lines $first_line-$last_line are";
+ }
+ else {
+ print $TESTERR "Line $first_line is";
+ }
+ print $TESTERR " missing:\n";
+ for my $i (@diff_lines) {
+ print $TESTERR "# $prefix - " . _quote($exp[$i->[1]]) . "\n";
+ }
+ }
+ elsif ($diff_kind eq "CH") {
+ if ($lines > 1) {
+ my $last_line = $diff_lines[-1][0] + 1;
+ print $TESTERR "Lines $first_line-$last_line are";
+ }
+ else {
+ print $TESTERR "Line $first_line is";
+ }
+ print $TESTERR " changed:\n";
+ for my $i (@diff_lines) {
+ print $TESTERR "# $prefix - " . _quote($exp[$i->[1]]) . "\n";
+ print $TESTERR "# $prefix + " . _quote($got[$i->[0]]) . "\n";
+ }
+ }
+
+ # reset
+ $diff_kind = undef;
+ @diff_lines = ();
+ };
+
+ my $diff_collect = sub {
+ my $kind = shift;
+ &$diff_flush() if $diff_kind && $diff_kind ne $kind;
+ $diff_kind = $kind;
+ push(@diff_lines, [@_]);
+ };
+
+ Algorithm::Diff::traverse_balanced(
+ \@got, \@exp,
+ {
+ DISCARD_A => sub { &$diff_collect("GOT", @_) },
+ DISCARD_B => sub { &$diff_collect("EXP", @_) },
+ CHANGE => sub { &$diff_collect("CH", @_) },
+ MATCH => sub { &$diff_flush() },
+ },
+ );
+ &$diff_flush();
+ }
+ else {
+ print $TESTERR <<EOT unless $told_about_diff++;
+# $prefix (Install the Algorithm::Diff module to have differences in multiline
+# $prefix output explained. You might also set the PERL_TEST_DIFF environment
+# $prefix variable to run a diff program on the output.)
+EOT
+ }
}
}
@@ -438,6 +546,24 @@
$ok;
}
+sub _quote {
+ my $str = shift;
+ return "<UNDEF>" unless defined $str;
+ $str =~ s/\\/\\\\/g;
+ $str =~ s/"/\\"/g;
+ $str =~ s/\a/\\a/g;
+ $str =~ s/[\b]/\\b/g;
+ $str =~ s/\e/\\e/g;
+ $str =~ s/\f/\\f/g;
+ $str =~ s/\n/\\n/g;
+ $str =~ s/\r/\\r/g;
+ $str =~ s/\t/\\t/g;
+ $str =~ s/([\0-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
+ $str =~ s/([\0-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
+ $str =~ s/([^\0-\176])/sprintf('\\x{%X}',ord($1))/eg;
+ return qq("$str");
+}
+
=item C<skip(I<skip_if_true>, I<args...>)>
This is used for tests that under some conditions can be skipped. It's
@@ -714,6 +840,17 @@
=back
+=head1 ENVIRONMENT
+
+If C<PERL_TEST_DIFF> environment variable is set, it will be used as a
+command to compare unexpected multiline results. If you have GNU diff
+you might want to set its value as C<diff -u>. If you don't have
+suitable program you might install the C<Text::Diff> module and then
+set C<PERL_TEST_DIFF> to be C<perl -MText::Diff -e 'print
+diff(@ARGV)'>. If C<PERL_TEST_DIFF> is not set and the
+C<Algorithm::Diff> module is available, then it will be used to
+explain differences in multiline results.
Sean M. Burke
>I personally like to use PERL_TEST_DIFF so here is a patch that does
>both. I hope that might make everybody happy. This is sample output:
Wow, that's pretty zippy stuff! I'll try applying this in the next day or two.