File Coverage

blib/lib/Test/Differences.pm
Criterion Covered Total %
statement 109 126 86.5
branch 57 78 73.0
condition 19 29 65.5
subroutine 22 22 100.0
pod 7 7 100.0
total 214 262 81.6


line stmt bran cond sub pod time code
1             package Test::Differences;
2              
3             =encoding utf8
4              
5             =head1 NAME
6              
7             Test::Differences - Test strings and data structures and show differences if not ok
8              
9             =head1 SYNOPSIS
10              
11             use Test; ## Or use Test::More
12             use Test::Differences;
13              
14             eq_or_diff $got, "a\nb\nc\n", "testing strings";
15             eq_or_diff \@got, [qw( a b c )], "testing arrays";
16              
17             ## Passing options:
18             eq_or_diff $got, $expected, $name, { context => 300 }; ## options
19              
20             ## Using with DBI-like data structures
21              
22             use DBI;
23              
24             ... open connection & prepare statement and @expected_... here...
25              
26             eq_or_diff $sth->fetchall_arrayref, \@expected_arrays "testing DBI arrays";
27             eq_or_diff $sth->fetchall_hashref, \@expected_hashes, "testing DBI hashes";
28              
29             ## To force textual or data line numbering (text lines are numbered 1..):
30             eq_or_diff_text ...;
31             eq_or_diff_data ...;
32              
33             =head1 EXPORT
34              
35             This module exports three test functions and four diff-style functions:
36              
37             =over 4
38              
39             =item * Test functions
40              
41             =over 4
42              
43             =item * C
44              
45             =item * C
46              
47             =item * C
48              
49             =back
50              
51             =item * Diff style functions
52              
53             =over 4
54              
55             =item * C (the default)
56              
57             =item * C
58              
59             =item * C
60              
61             =item * C
62              
63             =back
64              
65             =back
66              
67             =head1 DESCRIPTION
68              
69             When the code you're testing returns multiple lines, records or data
70             structures and they're just plain wrong, an equivalent to the Unix
71             C utility may be just what's needed. Here's output from an
72             example test script that checks two text documents and then two
73             (trivial) data structures:
74              
75             t/99example....1..3
76             not ok 1 - differences in text
77             # Failed test ((eval 2) at line 14)
78             # +---+----------------+----------------+
79             # | Ln|Got |Expected |
80             # +---+----------------+----------------+
81             # | 1|this is line 1 |this is line 1 |
82             # * 2|this is line 2 |this is line b *
83             # | 3|this is line 3 |this is line 3 |
84             # +---+----------------+----------------+
85             not ok 2 - differences in whitespace
86             # Failed test ((eval 2) at line 20)
87             # +---+------------------+------------------+
88             # | Ln|Got |Expected |
89             # +---+------------------+------------------+
90             # | 1| indented | indented |
91             # * 2| indented |\tindented *
92             # | 3| indented | indented |
93             # +---+------------------+------------------+
94             not ok 3
95             # Failed test ((eval 2) at line 22)
96             # +----+-------------------------------------+----------------------------+
97             # | Elt|Got |Expected |
98             # +----+-------------------------------------+----------------------------+
99             # * 0|bless( [ |[ *
100             # * 1| 'Move along, nothing to see here' | 'Dry, humorless message' *
101             # * 2|], 'Test::Builder' ) |] *
102             # +----+-------------------------------------+----------------------------+
103             # Looks like you failed 3 tests of 3.
104              
105             eq_or_diff_...() compares two strings or (limited) data structures and
106             either emits an ok indication or a side-by-side diff. Test::Differences
107             is designed to be used with Test.pm and with Test::Simple, Test::More,
108             and other Test::Builder based testing modules. As the SYNOPSIS shows,
109             another testing module must be used as the basis for your test suite.
110              
111             =head1 OPTIONS
112              
113             The options to C give some fine-grained control over the output.
114              
115             =over 4
116              
117             =item * C
118              
119             This allows you to control the amount of context shown:
120              
121             eq_or_diff $got, $expected, $name, { context => 50000 };
122              
123             will show you lots and lots of context. Normally, eq_or_diff() uses
124             some heuristics to determine whether to show 3 lines of context (like
125             a normal unified diff) or 25 lines.
126              
127             =item * C
128              
129             C or C. This normally defaults to C. If, however, neither of
130             C<$got> or C<$expected> is a reference then it defaults to C. You can
131             also force one or the other by calling C or
132             C.
133              
134             The difference is that in text mode lines are numbered from 1, but in data mode
135             from 0 (and are refered to as 'elements' (Elt) instead of lines):
136              
137             # +---+-------+----------+
138             # | Ln|Got |Expected |
139             # +---+-------+----------+
140             # * 1|'foo' |'bar' *
141             # +---+-------+----------+
142              
143             # +----+---------+----+----------+
144             # | Elt|Got | Elt|Expected |
145             # +----+---------+----+----------+
146             # * 0|[ * 0|'bar' *
147             # * 1| 'foo' * | |
148             # * 2|] * | |
149             # +----+---------+----+----------+
150              
151             The difference is purely cosmetic, it makes no difference to how comparisons
152             are performed.
153              
154             =item * C
155              
156             If passed, whatever value is added is used as the argument for L
157             Sortkeys option. See the L docs to understand how you can
158             control the Sortkeys behavior.
159              
160             =item * C and C
161              
162             The column headers to use in the output. They default to 'Got' and 'Expected'.
163              
164             =back
165              
166             =head1 DIFF STYLES
167              
168             For extremely long strings, a table diff can wrap on your screen and be hard
169             to read. If you are comfortable with different diff formats, you can switch
170             to a format more suitable for your data. These are the four formats supported
171             by the L module and are set with the following functions:
172              
173             =over 4
174              
175             =item * C (the default)
176              
177             =item * C
178              
179             =item * C
180              
181             =item * C
182              
183             =back
184              
185             You can run the following to understand the different diff output styles:
186              
187             use Test::More 'no_plan';
188             use Test::Differences;
189              
190             my $long_string = join '' => 1..40;
191              
192             TODO: {
193             local $TODO = 'Testing diff styles';
194              
195             # this is the default and does not need to explicitly set unless you need
196             # to reset it back from another diff type
197             table_diff;
198             eq_or_diff $long_string, "-$long_string", 'table diff';
199              
200             unified_diff;
201             eq_or_diff $long_string, "-$long_string", 'unified diff';
202              
203             context_diff;
204             eq_or_diff $long_string, "-$long_string", 'context diff';
205              
206             oldstyle_diff;
207             eq_or_diff $long_string, "-$long_string", 'oldstyle diff';
208             }
209              
210             =head1 UNICODE
211              
212             Generally you'll find that the following test output is disappointing.
213              
214             use Test::Differences;
215             use utf8;
216              
217             my $want = { 'Traditional Chinese' => '中國' };
218             my $have = { 'Traditional Chinese' => '中国' };
219              
220             eq_or_diff $have, $want, 'Unicode, baby';
221              
222             Here's what you get:
223              
224             # Failed test 'Unicode, baby'
225             # at t/unicode.t line 12.
226             # +----+-----------------------+-----------------------+
227             # | Elt|Got |Expected |
228             # +----+-----------------------+-----------------------+
229             # | 0|'Traditional Chinese' |'Traditional Chinese' |
230             # * 1|'\x{4e2d}\x{56fd}' |'\x{4e2d}\x{570b}' *
231             # +----+-----------------------+-----------------------+
232             # Looks like you failed 1 test of 1.
233             Dubious, test returned 1 (wstat 256, 0x100)
234             Failed 1/1 subtests
235              
236             A patch to fix this would be *most* welcome.
237              
238             =head1 Unknown::Values
239              
240             L is a module which provides values which will never compare as being
241             the same as anything else, not even the same as itself.
242              
243             If code looks too hard at one of these values (and Test::Differences looks very hard indeed)
244             that is a fatal error. This means that while we can detect the presence of these beasties,
245             and tell you that they compare different, for Complicated Internals Reasons we can't show you
246             much context. Sorry.
247              
248             NB that the support for these is experimental and relies on an undocumented unstable
249             interface in Unknown::Values. If that fails then Test::Differences will I just die
250             when it sees them instead of telling you that the comparison failed.
251              
252             =cut
253              
254             our $VERSION = "0.70"; # or "0.001_001" for a dev release
255             $VERSION = eval $VERSION;
256              
257 11     11   850267 use Exporter;
  11         151  
  11         738  
258              
259             @ISA = qw( Exporter );
260             @EXPORT = qw(
261             eq_or_diff
262             eq_or_diff_text
263             eq_or_diff_data
264             unified_diff
265             context_diff
266             oldstyle_diff
267             table_diff
268             );
269              
270 11     11   71 use strict;
  11         21  
  11         278  
271 11     11   77 use warnings;
  11         23  
  11         276  
272              
273 11     11   74 use Carp;
  11         23  
  11         658  
274 11     11   5738 use Text::Diff;
  11         99101  
  11         620  
275 11     11   7353 use Data::Dumper;
  11         78130  
  11         5649  
276              
277             {
278             my $diff_style = 'Table';
279             my %allowed_style = map { $_ => 1 } qw/Unified Context OldStyle Table/;
280             sub _diff_style {
281 31 100   31   304 return $diff_style unless @_;
282 4         8 my $requested_style = shift;
283 4 50       13 unless ( $allowed_style{$requested_style} ) {
284 0         0 Carp::croak("Uknown style ($requested_style) requested for diff");
285             }
286 4         11 $diff_style = $requested_style;
287             }
288             }
289              
290 1     1 1 412 sub unified_diff { _diff_style('Unified') }
291 1     1 1 363 sub context_diff { _diff_style('Context') }
292 1     1 1 325 sub oldstyle_diff { _diff_style('OldStyle') }
293 1     1 1 103 sub table_diff { _diff_style('Table') }
294              
295             sub _identify_callers_test_package_of_choice {
296             ## This is called at each test in case Test::Differences was used before
297             ## the base testing modules.
298             ## First see if %INC tells us much of interest.
299 35     35   1636 my $has_builder_pm = grep $_ eq "Test/Builder.pm", keys %INC;
300 35         1120 my $has_test_pm = grep $_ eq "Test.pm", keys %INC;
301              
302 35 50 33     252 return "Test" if $has_test_pm && !$has_builder_pm;
303 35 50 33     227 return "Test::Builder" if !$has_test_pm && $has_builder_pm;
304              
305 0 0 0     0 if ( $has_test_pm && $has_builder_pm ) {
306             ## TODO: Look in caller's namespace for hints. For now, assume Builder.
307             ## This should only ever be an issue if multiple test suites end
308             ## up in memory at once.
309 0         0 return "Test::Builder";
310             }
311             }
312              
313             my $warned_of_unknown_test_lib;
314              
315 1     1 1 331 sub eq_or_diff_text { $_[3] = { data_type => "text" }; goto &eq_or_diff; }
  1         7  
316 1     1 1 323 sub eq_or_diff_data { $_[3] = { data_type => "data" }; goto &eq_or_diff; }
  1         4  
317              
318             ## This string is a cheat: it's used to see if the two arrays of values
319             ## are identical. The stringified values are joined using this joint
320             ## and compared using eq. This is a deep equality comparison for
321             ## references and a shallow one for scalars.
322             my $joint = chr(0) . "A" . chr(1);
323              
324             sub _isnt_ARRAY_of_scalars {
325 47 100   47   109 return 1 if ref ne "ARRAY";
326 33         162 return scalar grep ref, @$_;
327             }
328              
329             sub _isnt_HASH_of_scalars {
330 22 100   22   55 return 1 if ref ne "HASH";
331 10         47 return scalar grep ref, values %$_;
332             }
333              
334 11     11   98 use constant ARRAY_of_scalars => "ARRAY of scalars";
  11         30  
  11         744  
335 11     11   83 use constant ARRAY_of_ARRAYs_of_scalars => "ARRAY of ARRAYs of scalars";
  11         21  
  11         649  
336 11     11   75 use constant ARRAY_of_HASHes_of_scalars => "ARRAY of HASHes of scalars";
  11         32  
  11         650  
337 11     11   104 use constant HASH_of_scalars => "HASH of scalars";
  11         41  
  11         10490  
338              
339             sub _grok_type {
340 70 50   70   186 local $_ = shift if @_;
341 70 100       211 return "SCALAR" unless ref;
342 33 100       131 if ( ref eq "ARRAY" ) {
    100          
343 24 100       64 return undef unless @$_;
344 23 100       62 return ARRAY_of_scalars
345             unless _isnt_ARRAY_of_scalars;
346 12 100       27 return ARRAY_of_ARRAYs_of_scalars
347             unless grep _isnt_ARRAY_of_scalars, @$_;
348 8 50       20 return ARRAY_of_HASHes_of_scalars
349             unless grep _isnt_HASH_of_scalars, @$_;
350 8         25 return 0;
351             }
352             elsif ( ref eq 'HASH' ) {
353 6 50       18 return HASH_of_scalars
354             unless _isnt_HASH_of_scalars($_);
355 0         0 return 0;
356             }
357             }
358              
359             sub eq_or_diff {
360 35     35 1 199317 my ( @vals, $name, $options );
361 35 100 100     229 $options = pop if @_ > 2 && ref $_[-1];
362 35         121 ( $vals[0], $vals[1], $name ) = @_;
363              
364 35         82 my @types = map { _grok_type($_) } @vals;
  70         152  
365 35   100     162 my $dump_it = !$types[0] || !$types[1];
366              
367 35         80 my($data_type, $filename_a, $filename_b);
368 35 100       112 if($options) {
369 4         11 $data_type = $options->{data_type};
370 4         5 $filename_a = $options->{filename_a};
371 4         9 $filename_b = $options->{filename_b};
372             }
373 35 100 100     179 $data_type ||= "text" unless ref $vals[0] || ref $vals[1];
      100        
374 35   100     138 $data_type ||= "data";
375              
376 35   50     166 $filename_a ||= 'Got';
377 35   50     144 $filename_b ||= 'Expected';
378              
379 35         47 my @widths;
380              
381 35 100       102 local $Data::Dumper::Deparse = 1
382             unless($Test::Differences::NoDeparse);
383 35         68 local $Data::Dumper::Indent = 1;
384 35         80 local $Data::Dumper::Purity = 0;
385 35         63 local $Data::Dumper::Terse = 1;
386 35         52 local $Data::Dumper::Deepcopy = 1;
387 35         63 local $Data::Dumper::Quotekeys = 0;
388 35         73 local $Data::Dumper::Useperl = 1;
389             local $Data::Dumper::Sortkeys =
390 35 50       118 exists $options->{Sortkeys} ? $options->{Sortkeys} : 1;
391              
392 35         63 my $unknown_value_in_got;
393             my $unknown_value_in_expected;
394 35         81 my @unknown_flags = (\$unknown_value_in_got, \$unknown_value_in_expected);
395              
396             my($got, $expected) = map {
397 35         72 my $t = eval { [ split /^/, Data::Dumper::Dumper($_) ] };
  70         104  
  70         245  
398              
399 70         29899 my $unknown_flag = shift(@unknown_flags);
400 70 50       197 if($@ =~ /^Dereferencing cannot be performed on unknown values at .*Unknown.Values.Instance/) {
401 0         0 ${$unknown_flag} = 1;
  0         0  
402             }
403              
404 70         201 $t;
405             } @vals;
406              
407 35         95 my $caller = caller;
408              
409 35   66     322 my $passed =
410             !defined($unknown_value_in_got) &&
411             !defined($unknown_value_in_expected) &&
412             join( $joint, @$got ) eq join( $joint, @$expected );
413              
414 35         70 my $diff;
415 35 100       78 unless ($passed) {
416 27 50       54 if($unknown_value_in_got) { $got = \"got something containing an Unknown::Values::unknown value" };
  0         0  
417 27 50       65 if($unknown_value_in_expected) { $expected = \"expected something containing an Unknown::Values::unknown value" };
  0         0  
418 27         42 my $context;
419              
420             $context = $options->{context}
421 27 100       63 if exists $options->{context};
422              
423 27 100       133 $context = $dump_it ? 2**31 : grep( @$_ > 25, $got, $expected ) ? 3 : 25
    100          
    100          
424             unless defined $context;
425              
426 27 50       192 confess "context must be an integer: '$context'\n"
427             unless $context =~ /\A\d+\z/;
428              
429 27 100       100 $diff = diff $got, $expected,
    100          
    100          
430             { CONTEXT => $context,
431             STYLE => _diff_style(),
432             FILENAME_A => $filename_a,
433             FILENAME_B => $filename_b,
434             OFFSET_A => $data_type eq "text" ? 1 : 0,
435             OFFSET_B => $data_type eq "text" ? 1 : 0,
436             INDEX_LABEL => $data_type eq "text" ? "Ln" : "Elt",
437             };
438 27         127470 chomp $diff;
439 27         60 $diff .= "\n";
440             }
441              
442 35         85 my $which = _identify_callers_test_package_of_choice;
443              
444 35 50       157 if ( $which eq "Test" ) {
    50          
445             @_
446 0 0       0 = $passed
447             ? ( "", "", $name )
448             : ( "\n$diff", "No differences", $name );
449 0         0 goto &Test::ok;
450             }
451             elsif ( $which eq "Test::Builder" ) {
452 35         161 my $test = Test::Builder->new;
453             ## TODO: Call exported_to here? May not need to because the caller
454             ## should have imported something based on Test::Builder already.
455 35         321 $test->ok( $passed, $name );
456 35 100       35584 $test->diag($diff) unless $passed;
457             }
458             else {
459 0 0         unless ($warned_of_unknown_test_lib) {
460 0           Carp::cluck
461             "Can't identify test lib in use, doesn't seem to be Test.pm or Test::Builder based\n";
462 0           $warned_of_unknown_test_lib = 1;
463             }
464             ## Play dumb and hope nobody notices the fool drooling in the corner
465 0 0         if ($passed) {
466 0           print "ok\n";
467             }
468             else {
469 0           $diff =~ s/^/# /gm;
470 0           print "not ok\n", $diff;
471             }
472             }
473             }
474              
475             =head1 LIMITATIONS
476              
477             =head2 C or C
478              
479             This module "mixes in" with Test.pm or any of the test libraries based on
480             Test::Builder (Test::Simple, Test::More, etc). It does this by peeking to see
481             whether Test.pm or Test/Builder.pm is in %INC, so if you are not using one of
482             those, it will print a warning and play dumb by not emitting test numbers (or
483             incrementing them). If you are using one of these, it should interoperate
484             nicely.
485              
486             =head2 Exporting
487              
488             Exports all 3 functions by default (and by design). Use
489              
490             use Test::Differences ();
491              
492             to suppress this behavior if you don't like the namespace pollution.
493              
494             This module will not override functions like ok(), is(), is_deeply(), etc. If
495             it did, then you could C to get
496             automatic upgrading to diffing behaviors without the C shown above.
497             Test::Differences intentionally does not provide this behavior because this
498             would mean that Test::Differences would need to emulate every popular test
499             module out there, which would require far more coding and maintenance that I'm
500             willing to do. Use the eval and my_ok deployment shown above if you want some
501             level of automation.
502              
503             =head2 Unicode
504              
505             Perls before 5.6.0 don't support characters > 255 at all, and 5.6.0
506             seems broken. This means that you might get odd results using perl5.6.0
507             with unicode strings.
508              
509             =head2 C and older Perls.
510              
511             Relies on Data::Dumper (for now), which, prior to perl5.8, will not always
512             report hashes in the same order. C< $Data::Dumper::Sortkeys > I set to 1,
513             so on more recent versions of Data::Dumper, this should not occur. Check CPAN
514             to see if it's been peeled out of the main perl distribution and backported.
515             Reported by Ilya Martynov , although the Sortkeys "future
516             perfect" workaround has been set in anticipation of a new Data::Dumper for a
517             while. Note that the two hashes should report the same here:
518              
519             not ok 5
520             # Failed test (t/ctrl/05-home.t at line 51)
521             # +----+------------------------+----+------------------------+
522             # | Elt|Got | Elt|Expected |
523             # +----+------------------------+----+------------------------+
524             # | 0|{ | 0|{ |
525             # | 1| 'password' => '', | 1| 'password' => '', |
526             # * 2| 'method' => 'login', * | |
527             # | 3| 'ctrl' => 'home', | 2| 'ctrl' => 'home', |
528             # | | * 3| 'method' => 'login', *
529             # | 4| 'email' => 'test' | 4| 'email' => 'test' |
530             # | 5|} | 5|} |
531             # +----+------------------------+----+------------------------+
532              
533             Data::Dumper also overlooks the difference between
534              
535             $a[0] = \$a[1];
536             $a[1] = \$a[0]; # $a[0] = \$a[1]
537              
538             and
539              
540             $x = \$y;
541             $y = \$x;
542             @a = ( $x, $y ); # $a[0] = \$y, not \$a[1]
543              
544             The former involves two scalars, the latter 4: $x, $y, and @a[0,1].
545             This was carefully explained to me in words of two syllables or less by
546             Yves Orton . The plan to address this is to allow
547             you to select Data::Denter or some other module of your choice as an
548             option.
549              
550             =head2 Code-refs
551              
552             Test::Differences turns on C<$Data::Dumper::Deparse>, so any code-refs in your
553             data structures will be turned into text before they are examined, using
554             L. The precise text generated for a sub-ref might not be what you
555             expect as it is generated from the compiled version of the code, but it should
556             at least be consistent and spot differences correctly.
557              
558             You can turn this behaviour off by setting C<$Test::Differences::NoDeparse>.
559              
560             =head1 AUTHORS
561              
562             Barrie Slaymaker - original author
563              
564             Curtis "Ovid" Poe
565              
566             David Cantrell
567              
568             =head1 LICENSE
569              
570             Copyright Barrie Slaymaker, Curtis "Ovid" Poe, and David Cantrell.
571              
572             All Rights Reserved.
573              
574             You may use, distribute and modify this software under the terms of the GNU
575             public license, any version, or the Artistic license.
576              
577             =cut
578              
579             1;