From 237ae7ef121382bdbd50f757383212de34e11909 Mon Sep 17 00:00:00 2001 From: Packit Date: Sep 16 2020 16:16:57 +0000 Subject: perl-Test-Differences-0.6400 base --- diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..41f9162 --- /dev/null +++ b/Build.PL @@ -0,0 +1,24 @@ +use strict; +use warnings; +use Module::Build; + +my $builder = Module::Build->new( + module_name => 'Test::Differences', + license => 'perl', + dist_author => 'David Cantrell 'lib/Test/Differences.pm', + perl => 5.006, + requires => { + 'Test::More' => '0.88', # done_testing + 'Text::Diff' => 0.35, + 'Data::Dumper' => 2.126, + 'Capture::Tiny' => 0.24, + }, + add_to_cleanup => ['Test-Differences-*'], + meta_merge => { + resources => + { repository => 'https://github.com/Ovid/Test-Differences' } + }, +); + +$builder->create_build_script(); diff --git a/Changes b/Changes new file mode 100644 index 0000000..3b75016 --- /dev/null +++ b/Changes @@ -0,0 +1,98 @@ +Changes file for Test::Differences + +0.64 Sun November 22, 2015 + - Bump dependency version for Text::Diff to avoid a buggy release + - Make tests pass with relocation perl (see + https://rt.cpan.org/Ticket/Display.html?id=103133) + +0.63 Thu November 20, 2014 + - Minor doco-fixes + - Remove use of flatten, always use Data::Dumper for saner, more readable + output, fixes RT #95446 (David Precious (bigpresh)) + +0.62 Wed June 25, 2014 + - Production release + +0.61_01 Thu June 19, 2014 + - Document the Text::Diff unicode fix. + - Add ability to customise 'Got' and 'Expected' column headers + +0.61 Sat April 16, 2011 + - Allow an option to override Sortkeys in C. Thanks to Mark + Zealey for the suggestion. + - Unnumbered tests. There's no point to them. + +0.60 Sat April 16, 2011 + - Make '' and undef not equal. Thanks to Pavel Shaydo for the patch. + - Made Data::Dumper minimum version 2.126 to resolve + https://rt.cpan.org/Ticket/Display.html?id=60798. Thanks to + jjnapiork@cpan.org for the report and fix. + +0.50 Sat Oct 17 15:18:03 2009 + - Production release. + +0.49_02 Sat Aug 2 13:00:21 GMT 2008 + - Added support for all diff styles supplied by Text::Diff. Requested by + Kevin Jones (http://rt.cpan.org/Public/Bug/Display.html?id=23579) + - Add Build.PL. + - Convert to universally use Test::More instead of Test. + +0.49_01 Fri Aug 1 09:04:58 GMT 2008 + - Convert to modern Perl distribution. + - Applied doc suggestion from Slaven Rezic + (http://rt.cpan.org/Ticket/Display.html?id=24297) + - Bumped up version number higher than normal because I forgot to quote + the "developer release" number last time. + - Applied Mark Stosberg's patch which fixed the { a => 1 } versus + { a => '1' } bug (http://rt.cpan.org/Ticket/Display.html?id=3029) + +0.48_01 Wed Jul 30 10:42:52 GMT 2008 + - Fixed bug when comparing AoH with non-scalar values. Reported (with + fix) by Mark Zealey + (http://rt.cpan.org/Public/Bug/Display.html?id=29732) + +0.47 Tue Jun 17 08:54:59 EDT 2003 + - Add context option (reworked patch from fetko@slaysys.com) + - Improve options handling for eq_or_diff(), $name is no longer + required before \%options + - Use **, not ^, for exponentiation + ("Blake D. Mills IV" ) + +0.46 Tue Aug 27 13:45:51 EDT 2002 + - Minor doc tweaks + +0.45 Sun Jul 14 06:58:48 EDT 2002 + - Fix $Data::Dumper::FooBar to be ...::Foobar, patch by + Ilya Martynov + - Correct the "use Test::Differences" example. + - Require Text::Diff 0.34 in to get escaping fixes. + +0.44 Mon Jul 8 17:02:11 EDT 2002 + - Document Data::Dumper shortcomings reported by Yves Orton + and Ilya Martynov . + +0.43 Mon May 13 09:49:50 EDT 2002 + - Dump "unknown" structures instead of treating them like + arrays of scalars. Reported by Yves Orton . + +0.42 Wed Jan 2 21:31:32 EST 2002 + - T.J. Mather spotted a bug where two identical results would compare + as different, causing false negatives. + +0.41 + - forgot to log this change. + +0.4 Fri Dec 21 08:55:13 EST 2001 + - Moved table style diffs and escaping in to Test::Diff + - Improve docs + - Add a few more tests + +0.3 Sat Dec 15 02:06:26 EST 2001 + - Only use Data::Dumper on both args or neither arg. + - Improve escaping (Michael G Schwern , + - remove leftover debugging code (Tatsuhiko Miyagawa ) + - add t/00escape.t + - PREREQ_PM => 'Text::Diff' (Michael G Schwern ) + +0.2 + - Initial public release diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..378e069 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,24 @@ +Build.PL +Changes +lib/Test/Differences.pm +Makefile.PL +MANIFEST +README +t/00-load.t +t/text_vs_data.t +t/pass.t +t/struct.t +t/test.t +t/undef.t +t/example.t +t/diff_styles.t +t/boilerplate.t +t/pod-coverage.t +t/pod.t +t/regression.t +t/column-headers.t +t/script/custom-headers +t/script/default-headers +MANIFEST.SKIP +META.yml Module YAML meta-data (added by MakeMaker) +META.json Module JSON meta-data (added by MakeMaker) diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..44c2fad --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,2 @@ +.travis.yml +^\.git diff --git a/META.json b/META.json new file mode 100644 index 0000000..2c52124 --- /dev/null +++ b/META.json @@ -0,0 +1,52 @@ +{ + "abstract" : "Test strings and data structures and show differences if not ok", + "author" : [ + "David Cantrell " + ], + "dynamic_config" : 1, + "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001", + "license" : [ + "unknown" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Test-Differences", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : { + "Capture::Tiny" : "0.24", + "Data::Dumper" : "2.126", + "Test::More" : "0.88", + "Text::Diff" : "1.43" + } + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "web" : "https://github.com/Ovid/Test-Differences/issues" + }, + "repository" : { + "url" : "https://github.com/Ovid/Test-Differences" + } + }, + "version" : "0.64" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..c51e783 --- /dev/null +++ b/META.yml @@ -0,0 +1,28 @@ +--- +abstract: 'Test strings and data structures and show differences if not ok' +author: + - 'David Cantrell ' +build_requires: + ExtUtils::MakeMaker: '0' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 1 +generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001' +license: unknown +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Test-Differences +no_index: + directory: + - t + - inc +requires: + Capture::Tiny: '0.24' + Data::Dumper: '2.126' + Test::More: '0.88' + Text::Diff: '1.43' +resources: + bugtracker: https://github.com/Ovid/Test-Differences/issues + repository: https://github.com/Ovid/Test-Differences +version: '0.64' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..f346ccf --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,31 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; + +eval "use 5.006"; +if ( my $error = $@ ) { + warn $error; + exit 0; +} + +WriteMakefile( + NAME => 'Test::Differences', + AUTHOR => 'David Cantrell ', + VERSION_FROM => 'lib/Test/Differences.pm', + ABSTRACT_FROM => 'lib/Test/Differences.pm', + PL_FILES => {}, + PREREQ_PM => { + 'Test::More' => '0.88', # done_testing + 'Text::Diff' => 1.43, + 'Data::Dumper' => 2.126, + 'Capture::Tiny' => 0.24, + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => 'Test-Differences-*' }, + META_MERGE => { + resources => { + repository => 'https://github.com/Ovid/Test-Differences', + bugtracker => 'https://github.com/Ovid/Test-Differences/issues', + }, + }, +); diff --git a/README b/README new file mode 100644 index 0000000..852983b --- /dev/null +++ b/README @@ -0,0 +1,40 @@ +Test-Differences + +INSTALLATION + +To install this module, run the following commands: + + perl Makefile.PL + make + make test + make install + +SUPPORT AND DOCUMENTATION + +After installing, you can find documentation for this module with the +perldoc command. + + perldoc Test::Differences + +You can also look for information at: + + RT, CPAN's request tracker + http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Differences + + AnnoCPAN, Annotated CPAN documentation + http://annocpan.org/dist/Test-Differences + + CPAN Ratings + http://cpanratings.perl.org/d/Test-Differences + + Search CPAN + http://search.cpan.org/dist/Test-Differences + + +COPYRIGHT AND LICENCE + +Copyright (C) 2008 Curtis "Ovid" Poe + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + diff --git a/lib/Test/Differences.pm b/lib/Test/Differences.pm new file mode 100644 index 0000000..2336d4b --- /dev/null +++ b/lib/Test/Differences.pm @@ -0,0 +1,580 @@ +package Test::Differences; + +=encoding utf8 + +=head1 NAME + +Test::Differences - Test strings and data structures and show differences if not ok + +=head1 VERSION + +0.62 + +=head1 SYNOPSIS + + use Test; ## Or use Test::More + use Test::Differences; + + eq_or_diff $got, "a\nb\nc\n", "testing strings"; + eq_or_diff \@got, [qw( a b c )], "testing arrays"; + + ## Passing options: + eq_or_diff $got, $expected, $name, { context => 300 }; ## options + + ## Using with DBI-like data structures + + use DBI; + + ... open connection & prepare statement and @expected_... here... + + eq_or_diff $sth->fetchall_arrayref, \@expected_arrays "testing DBI arrays"; + eq_or_diff $sth->fetchall_hashref, \@expected_hashes, "testing DBI hashes"; + + ## To force textual or data line numbering (text lines are numbered 1..): + eq_or_diff_text ...; + eq_or_diff_data ...; + +=head1 EXPORT + +This module exports three test functions and four diff-style functions: + +=over 4 + +=item * Test functions + +=over 4 + +=item * C + +=item * C + +=item * C + +=back + +=item * Diff style functions + +=over 4 + +=item * C (the default) + +=item * C + +=item * C + +=item * C + +=back + +=back + +=head1 DESCRIPTION + +When the code you're testing returns multiple lines, records or data +structures and they're just plain wrong, an equivalent to the Unix +C utility may be just what's needed. Here's output from an +example test script that checks two text documents and then two +(trivial) data structures: + + t/99example....1..3 + not ok 1 - differences in text + # Failed test ((eval 2) at line 14) + # +---+----------------+----------------+ + # | Ln|Got |Expected | + # +---+----------------+----------------+ + # | 1|this is line 1 |this is line 1 | + # * 2|this is line 2 |this is line b * + # | 3|this is line 3 |this is line 3 | + # +---+----------------+----------------+ + not ok 2 - differences in whitespace + # Failed test ((eval 2) at line 20) + # +---+------------------+------------------+ + # | Ln|Got |Expected | + # +---+------------------+------------------+ + # | 1| indented | indented | + # * 2| indented |\tindented * + # | 3| indented | indented | + # +---+------------------+------------------+ + not ok 3 + # Failed test ((eval 2) at line 22) + # +----+-------------------------------------+----------------------------+ + # | Elt|Got |Expected | + # +----+-------------------------------------+----------------------------+ + # * 0|bless( [ |[ * + # * 1| 'Move along, nothing to see here' | 'Dry, humorless message' * + # * 2|], 'Test::Builder' ) |] * + # +----+-------------------------------------+----------------------------+ + # Looks like you failed 3 tests of 3. + +eq_or_diff_...() compares two strings or (limited) data structures and +either emits an ok indication or a side-by-side diff. Test::Differences +is designed to be used with Test.pm and with Test::Simple, Test::More, +and other Test::Builder based testing modules. As the SYNOPSIS shows, +another testing module must be used as the basis for your test suite. + +=head1 OPTIONS + +The options to C give some fine-grained control over the output. + +=over 4 + +=item * C + +This allows you to control the amount of context shown: + + eq_or_diff $got, $expected, $name, { context => 50000 }; + +will show you lots and lots of context. Normally, eq_or_diff() uses +some heuristics to determine whether to show 3 lines of context (like +a normal unified diff) or 25 lines. + +=item * C + +C or C. See C and C to +understand this. You can usually ignore this. + +=item * C + +If passed, whatever value is added is used as the argument for L +Sortkeys option. See the L docs to understand how you can +control the Sortkeys behavior. + +=item * C and C + +The column headers to use in the output. They default to 'Got' and 'Expected'. + +=back + +=head1 DIFF STYLES + +For extremely long strings, a table diff can wrap on your screen and be hard +to read. If you are comfortable with different diff formats, you can switch +to a format more suitable for your data. These are the four formats supported +by the L module and are set with the following functions: + +=over 4 + +=item * C (the default) + +=item * C + +=item * C + +=item * C + +=back + +You can run the following to understand the different diff output styles: + + use Test::More 'no_plan'; + use Test::Differences; + + my $long_string = join '' => 1..40; + + TODO: { + local $TODO = 'Testing diff styles'; + + # this is the default and does not need to explicitly set unless you need + # to reset it back from another diff type + table_diff; + eq_or_diff $long_string, "-$long_string", 'table diff'; + + unified_diff; + eq_or_diff $long_string, "-$long_string", 'unified diff'; + + context_diff; + eq_or_diff $long_string, "-$long_string", 'context diff'; + + oldstyle_diff; + eq_or_diff $long_string, "-$long_string", 'oldstyle diff'; + } + +=head1 UNICODE + +Generally you'll find that the following test output is disappointing. + + use Test::Differences; + + my $want = { 'Traditional Chinese' => '中國' }; + my $have = { 'Traditional Chinese' => '中国' }; + + eq_or_diff $have, $want, 'Unicode, baby'; + +The output looks like this: + + # Failed test 'Unicode, baby' + # at t/unicode.t line 12. + # +----+----------------------------+----------------------------+ + # | Elt|Got |Expected | + # +----+----------------------------+----------------------------+ + # | 0|'Traditional Chinese' |'Traditional Chinese' | + # * 1|'\xe4\xb8\xad\xe5\x9b\xbd' |'\xe4\xb8\xad\xe5\x9c\x8b' * + # +----+----------------------------+----------------------------+ + # Looks like you failed 1 test of 1. + Dubious, test returned 1 (wstat 256, 0x100) + +This is generally not helpful and someone points out that you didn't declare +your test program as being utf8, so you do that: + + use Test::Differences; + use utf8; + + my $want = { 'Traditional Chinese' => '中國' }; + my $have = { 'Traditional Chinese' => '中国' }; + + eq_or_diff $have, $want, 'Unicode, baby'; + + +Here's what you get: + + # Failed test 'Unicode, baby' + # at t/unicode.t line 12. + # +----+-----------------------+-----------------------+ + # | Elt|Got |Expected | + # +----+-----------------------+-----------------------+ + # | 0|'Traditional Chinese' |'Traditional Chinese' | + # * 1|'\x{4e2d}\x{56fd}' |'\x{4e2d}\x{570b}' * + # +----+-----------------------+-----------------------+ + # Looks like you failed 1 test of 1. + Dubious, test returned 1 (wstat 256, 0x100) + Failed 1/1 subtests + +That's better, but still awful. However, if you have C 0.40 or +higher installed, you can add this to your code: + + BEGIN { $ENV{DIFF_OUTPUT_UNICODE} = 1 } + +Make sure you do this I you load L. Then this is the output: + + # +----+-----------------------+-----------------------+ + # | Elt|Got |Expected | + # +----+-----------------------+-----------------------+ + # | 0|'Traditional Chinese' |'Traditional Chinese' | + # * 1|'中国' |'中國' * + # +----+-----------------------+-----------------------+ + +=head1 DEPLOYING + +There are several basic ways of deploying Test::Differences requiring more or less +labor by you or your users. + +=over + +=item * + +Fallback to C. + +This is your best option if you want this module to be optional. + + use Test::More; + BEGIN { + if (!eval q{ use Test::Differences; 1 }) { + *eq_or_diff = \&is_deeply; + } + } + +=item * + + eval "use Test::Differences"; + +If you want to detect the presence of Test::Differences on the fly, something +like the following code might do the trick for you: + + use Test qw( !ok ); ## get all syms *except* ok + + eval "use Test::Differences"; + use Data::Dumper; + + sub ok { + goto &eq_or_diff if defined &eq_or_diff && @_ > 1; + @_ = map ref $_ ? Dumper( @_ ) : $_, @_; + goto Test::&ok; + } + + plan tests => 1; + + ok "a", "b"; + +=item * + +PREREQ_PM => { .... "Test::Differences" => 0, ... } + +This method will let CPAN and CPANPLUS users download it automatically. It +will discomfit those users who choose/have to download all packages manually. + +=item * + +t/lib/Test/Differences.pm, t/lib/Text/Diff.pm, ... + +By placing Test::Differences and its prerequisites in the t/lib directory, you +avoid forcing your users to download the Test::Differences manually if they +aren't using CPAN or CPANPLUS. + +If you put a C in the top of each test suite before the +C, C should work well. + +You might want to check once in a while for new Test::Differences releases +if you do this. + + + +=back + +=cut + +our $VERSION = "0.64"; # or "0.001_001" for a dev release +$VERSION = eval $VERSION; + +use Exporter; + +@ISA = qw( Exporter ); +@EXPORT = qw( + eq_or_diff + eq_or_diff_text + eq_or_diff_data + unified_diff + context_diff + oldstyle_diff + table_diff +); + +use strict; + +use Carp; +use Text::Diff; +use Data::Dumper; + +{ + my $diff_style = 'Table'; + my %allowed_style = map { $_ => 1 } qw/Unified Context OldStyle Table/; + sub _diff_style { + return $diff_style unless @_; + my $requested_style = shift; + unless ( $allowed_style{$requested_style} ) { + Carp::croak("Uknown style ($requested_style) requested for diff"); + } + $diff_style = $requested_style; + } +} + +sub unified_diff { _diff_style('Unified') } +sub context_diff { _diff_style('Context') } +sub oldstyle_diff { _diff_style('OldStyle') } +sub table_diff { _diff_style('Table') } + +sub _identify_callers_test_package_of_choice { + ## This is called at each test in case Test::Differences was used before + ## the base testing modules. + ## First see if %INC tells us much of interest. + my $has_builder_pm = grep $_ eq "Test/Builder.pm", keys %INC; + my $has_test_pm = grep $_ eq "Test.pm", keys %INC; + + return "Test" if $has_test_pm && !$has_builder_pm; + return "Test::Builder" if !$has_test_pm && $has_builder_pm; + + if ( $has_test_pm && $has_builder_pm ) { + ## TODO: Look in caller's namespace for hints. For now, assume Builder. + ## This should only ever be an issue if multiple test suites end + ## up in memory at once. + return "Test::Builder"; + } +} + +my $warned_of_unknown_test_lib; + +sub eq_or_diff_text { $_[3] = { data_type => "text" }; goto &eq_or_diff; } +sub eq_or_diff_data { $_[3] = { data_type => "data" }; goto &eq_or_diff; } + +## This string is a cheat: it's used to see if the two arrays of values +## are identical. The stringified values are joined using this joint +## and compared using eq. This is a deep equality comparison for +## references and a shallow one for scalars. +my $joint = chr(0) . "A" . chr(1); + +sub eq_or_diff { + my ( @vals, $name, $options ); + $options = pop if @_ > 2 && ref $_[-1]; + ( $vals[0], $vals[1], $name ) = @_; + + my($data_type, $filename_a, $filename_b); + if($options) { + $data_type = $options->{data_type}; + $filename_a = $options->{filename_a}; + $filename_b = $options->{filename_b}; + } + $data_type ||= "text" unless ref $vals[0] || ref $vals[1]; + $data_type ||= "data"; + + $filename_a ||= 'Got'; + $filename_b ||= 'Expected'; + + my @widths; + + local $Data::Dumper::Indent = 1; + local $Data::Dumper::Purity = 0; + local $Data::Dumper::Terse = 1; + local $Data::Dumper::Deepcopy = 1; + local $Data::Dumper::Quotekeys = 0; + local $Data::Dumper::Useperl = 1; + local $Data::Dumper::Sortkeys = + exists $options->{Sortkeys} ? $options->{Sortkeys} : 1; + my ( $got, $expected ) = map + [ split /^/, Data::Dumper::Dumper($_) ], + @vals; + + my $caller = caller; + + my $passed + = join( $joint, @$got ) eq join( $joint, @$expected ); + + my $diff; + unless ($passed) { + my $context; + + $context = $options->{context} + if exists $options->{context}; + + $context = 2**31 unless defined $context; + + confess "context must be an integer: '$context'\n" + unless $context =~ /\A\d+\z/; + + $diff = diff $got, $expected, + { CONTEXT => $context, + STYLE => _diff_style(), + FILENAME_A => $filename_a, + FILENAME_B => $filename_b, + OFFSET_A => $data_type eq "text" ? 1 : 0, + OFFSET_B => $data_type eq "text" ? 1 : 0, + INDEX_LABEL => $data_type eq "text" ? "Ln" : "Elt", + }; + chomp $diff; + $diff .= "\n"; + } + + my $which = _identify_callers_test_package_of_choice; + + if ( $which eq "Test" ) { + @_ + = $passed + ? ( "", "", $name ) + : ( "\n$diff", "No differences", $name ); + goto &Test::ok; + } + elsif ( $which eq "Test::Builder" ) { + my $test = Test::Builder->new; + ## TODO: Call exported_to here? May not need to because the caller + ## should have imported something based on Test::Builder already. + $test->ok( $passed, $name ); + $test->diag($diff) unless $passed; + } + else { + unless ($warned_of_unknown_test_lib) { + Carp::cluck + "Can't identify test lib in use, doesn't seem to be Test.pm or Test::Builder based\n"; + $warned_of_unknown_test_lib = 1; + } + ## Play dumb and hope nobody notices the fool drooling in the corner + if ($passed) { + print "ok\n"; + } + else { + $diff =~ s/^/# /gm; + print "not ok\n", $diff; + } + } +} + +=head1 LIMITATIONS + +=head2 C or C + +This module "mixes in" with Test.pm or any of the test libraries based on +Test::Builder (Test::Simple, Test::More, etc). It does this by peeking to see +whether Test.pm or Test/Builder.pm is in %INC, so if you are not using one of +those, it will print a warning and play dumb by not emitting test numbers (or +incrementing them). If you are using one of these, it should interoperate +nicely. + +=head2 Exporting + +Exports all 3 functions by default (and by design). Use + + use Test::Differences (); + +to suppress this behavior if you don't like the namespace pollution. + +This module will not override functions like ok(), is(), is_deeply(), etc. If +it did, then you could C to get +automatic upgrading to diffing behaviors without the C shown above. +Test::Differences intentionally does not provide this behavior because this +would mean that Test::Differences would need to emulate every popular test +module out there, which would require far more coding and maintenance that I'm +willing to do. Use the eval and my_ok deployment shown above if you want some +level of automation. + +=head2 Unicode + +Perls before 5.6.0 don't support characters > 255 at all, and 5.6.0 +seems broken. This means that you might get odd results using perl5.6.0 +with unicode strings. + +=head2 C and older Perls. + +Relies on Data::Dumper (for now), which, prior to perl5.8, will not always +report hashes in the same order. C< $Data::Dumper::Sortkeys > I set to 1, +so on more recent versions of Data::Dumper, this should not occur. Check CPAN +to see if it's been peeled out of the main perl distribution and backported. +Reported by Ilya Martynov , although the Sortkeys "future +perfect" workaround has been set in anticipation of a new Data::Dumper for a +while. Note that the two hashes should report the same here: + + not ok 5 + # Failed test (t/ctrl/05-home.t at line 51) + # +----+------------------------+----+------------------------+ + # | Elt|Got | Elt|Expected | + # +----+------------------------+----+------------------------+ + # | 0|{ | 0|{ | + # | 1| 'password' => '', | 1| 'password' => '', | + # * 2| 'method' => 'login', * | | + # | 3| 'ctrl' => 'home', | 2| 'ctrl' => 'home', | + # | | * 3| 'method' => 'login', * + # | 4| 'email' => 'test' | 4| 'email' => 'test' | + # | 5|} | 5|} | + # +----+------------------------+----+------------------------+ + +Data::Dumper also overlooks the difference between + + $a[0] = \$a[1]; + $a[1] = \$a[0]; # $a[0] = \$a[1] + +and + + $x = \$y; + $y = \$x; + @a = ( $x, $y ); # $a[0] = \$y, not \$a[1] + +The former involves two scalars, the latter 4: $x, $y, and @a[0,1]. +This was carefully explained to me in words of two syllables or less by +Yves Orton . The plan to address this is to allow +you to select Data::Denter or some other module of your choice as an +option. + +=head1 AUTHORS + + Barrie Slaymaker - original author + + Curtis "Ovid" Poe + + David Cantrell + +=head1 LICENSE + +Copyright 2001-2008 Barrie Slaymaker, All Rights Reserved. + +You may use this software under the terms of the GNU public license, any +version, or the Artistic license. + +=cut + +1; diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..24ad429 --- /dev/null +++ b/t/00-load.t @@ -0,0 +1,9 @@ +#!perl -T + +use Test::More tests => 1; + +BEGIN { + use_ok( 'Test::Differences' ); +} + +diag( "Testing Test::Differences $Test::Differences::VERSION, Perl $], $^X" ); diff --git a/t/boilerplate.t b/t/boilerplate.t new file mode 100644 index 0000000..1ec32e1 --- /dev/null +++ b/t/boilerplate.t @@ -0,0 +1,47 @@ +#!perl -T + +use strict; +use warnings; +use Test::More tests => 3; + +sub not_in_file_ok { + my ( $filename, %regex ) = @_; + open( my $fh, '<', $filename ) + or die "couldn't open $filename for reading: $!"; + + my %violated; + + while ( my $line = <$fh> ) { + while ( my ( $desc, $regex ) = each %regex ) { + if ( $line =~ $regex ) { + push @{ $violated{$desc} ||= [] }, $.; + } + } + } + + if (%violated) { + fail("$filename contains boilerplate text"); + diag "$_ appears on lines @{$violated{$_}}" for keys %violated; + } + else { + pass("$filename contains no boilerplate text"); + } +} + +sub module_boilerplate_ok { + my ($module) = @_; + not_in_file_ok( + $module => 'the great new $MODULENAME' => qr/ - The great new /, + 'boilerplate description' => qr/Quick summary of what the module/, + 'stub function definition' => qr/function[12]/, + ); +} + +not_in_file_ok( + README => "The README is used..." => qr/The README is used/, + "'version information here'" => qr/to provide version information/, +); + +not_in_file_ok( Changes => "placeholder date/time" => qr(Date/time) ); + +module_boilerplate_ok('lib/Test/Differences.pm'); diff --git a/t/column-headers.t b/t/column-headers.t new file mode 100644 index 0000000..4277495 --- /dev/null +++ b/t/column-headers.t @@ -0,0 +1,52 @@ +use strict; +use warnings; + +use Test::More; +use Capture::Tiny qw(capture); + +END { done_testing(); } + +my($stdout, $stderr) = capture { system ( + $^X, (map { "-I$_" } (@INC)), + 't/script/default-headers' +) }; + +is( + $stderr, +" +# Failed test 'both the same' +# at t/script/default-headers line 8. +# +----+----------------+----------------+ +# | Elt|Got |Expected | +# +----+----------------+----------------+ +# | 0|{ |{ | +# * 1| foo => 'bar' | foo => 'baz' * +# | 2|} |} | +# +----+----------------+----------------+ +# Looks like you failed 1 test of 1. +", + "got expected error output" +); + +($stdout, $stderr) = capture { system ( + $^X, (map { "-I$_" } (@INC)), + 't/script/custom-headers' +) }; + +is( + $stderr, +" +# Failed test 'both the same' +# at t/script/custom-headers line 8. +# +----+----------------+----------------+ +# | Elt|Lard |Chips | +# +----+----------------+----------------+ +# | 0|{ |{ | +# * 1| foo => 'bar' | foo => 'baz' * +# | 2|} |} | +# +----+----------------+----------------+ +# Looks like you failed 1 test of 1. +", + "got expected error output" +); + diff --git a/t/diff_styles.t b/t/diff_styles.t new file mode 100644 index 0000000..b4ce06a --- /dev/null +++ b/t/diff_styles.t @@ -0,0 +1,21 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More 'no_plan'; +use Test::Differences; + +my $got = join '' => 1..40; + +TODO: { + local $TODO = 'Testing diff styles'; + table_diff; + eq_or_diff $got, "-$got", 'table diff'; + unified_diff; + eq_or_diff $got, "-$got", 'unified diff'; + context_diff; + eq_or_diff $got, "-$got", 'context diff'; + oldstyle_diff; + eq_or_diff $got, "-$got", 'oldstyle diff'; +} diff --git a/t/example.t b/t/example.t new file mode 100644 index 0000000..a6cec1e --- /dev/null +++ b/t/example.t @@ -0,0 +1,41 @@ +use strict; +my $x; + +my $demo = $ENV{DEMO}; + +eval <<'PRELOAD' ? eval <<'TEST' : ( $x = $@, eval <<'FALLBACK' ); + use Test::More; + 1; +PRELOAD + use Test::Differences; + + plan tests => 3 ; + + print "#\n# This test misuses TODO:", + " these TODOs are actually real tests.\n#\n" + unless $demo; + TODO: { + local $TODO = "testing failure, not really a TODO" unless $demo; + my @docs = ( + join( "", map "this is line $_\n", qw( 1 2 3 ) ), + join( "", map "this is line $_\n", qw( 1 b 3 ) ) + ); + eq_or_diff @docs, "differences in text"; + + @docs = ( ( " indented\n" x 3 ) x 2 ); + + $docs[1] =~ s/(^..*?^)\s+/$1\t/ms or die "Can't subst \\t for ' '"; + + eq_or_diff @docs, "differences in whitespace"; + + eq_or_diff( Test::Builder->new, [ "Dry, humorless message" ] ); + } +TEST + use Test; + + plan tests => 1; + + skip $x, "" ; +FALLBACK + +die $@ if $@; diff --git a/t/pass.t b/t/pass.t new file mode 100644 index 0000000..5ae3cf7 --- /dev/null +++ b/t/pass.t @@ -0,0 +1,15 @@ +use Test::More; +use Test::Differences; + +# use large enough data sets that this thing chooses context => 3 instead +# of "full document context". +my $a = ( "\n" x 30 ) . "a\n"; +my $b = ( "\n" x 30 ) . "b\n"; + +my @tests = ( + sub { eq_or_diff [ "a", "b" ], [ "a", "b" ] }, +); + +plan tests => scalar @tests; + +$_->() for @tests; diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..fc40a57 --- /dev/null +++ b/t/pod-coverage.t @@ -0,0 +1,18 @@ +use strict; +use warnings; +use Test::More; + +# Ensure a recent version of Test::Pod::Coverage +my $min_tpc = 1.08; +eval "use Test::Pod::Coverage $min_tpc"; +plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" + if $@; + +# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, +# but older versions don't recognize some common documentation styles +my $min_pc = 0.18; +eval "use Pod::Coverage $min_pc"; +plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" + if $@; + +all_pod_coverage_ok(); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..ee8b18a --- /dev/null +++ b/t/pod.t @@ -0,0 +1,12 @@ +#!perl -T + +use strict; +use warnings; +use Test::More; + +# Ensure a recent version of Test::Pod +my $min_tp = 1.22; +eval "use Test::Pod $min_tp"; +plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; + +all_pod_files_ok(); diff --git a/t/regression.t b/t/regression.t new file mode 100644 index 0000000..674bd58 --- /dev/null +++ b/t/regression.t @@ -0,0 +1,26 @@ +#!/usr/bin/perl -w + +use strict; + +use Test::More; +use Test::Differences; + +my %cases = ( + 'AoH with non-scalar values' => { + got => [ { a => 1 }, { b => 1, c => [] } ], + expected => [ { a => 1 }, { b => 1, c => [] } ] + }, + 'Numbers and strings' => { + got => { order_id => 127 }, + expected => { order_id => '127' }, + }, +); + +my @tests; +while ( my ( $name, $test ) = each %cases ) { + push @tests => sub { eq_or_diff $test->{got}, $test->{expected}, $name }; +} + +plan tests => scalar @tests; + +$_->() for @tests; diff --git a/t/script/custom-headers b/t/script/custom-headers new file mode 100644 index 0000000..8d8d4c7 --- /dev/null +++ b/t/script/custom-headers @@ -0,0 +1,13 @@ +use strict; +use warnings; + +use Test::More; +use Test::Differences; +END { done_testing(); } + +eq_or_diff( + { foo => 'bar' }, + { foo => 'baz' }, + "both the same", + { filename_a => 'Lard', filename_b => 'Chips' } +); diff --git a/t/script/default-headers b/t/script/default-headers new file mode 100644 index 0000000..9d7e59f --- /dev/null +++ b/t/script/default-headers @@ -0,0 +1,12 @@ +use strict; +use warnings; + +use Test::More; +use Test::Differences; +END { done_testing(); } + +eq_or_diff( + { foo => 'bar' }, + { foo => 'baz' }, + "both the same" +); diff --git a/t/struct.t b/t/struct.t new file mode 100644 index 0000000..af66393 --- /dev/null +++ b/t/struct.t @@ -0,0 +1,19 @@ +use Test::More; + +use Test::Differences; + +## This mind-bender submitted by Yves Orton +my ( $ar, $x, $y ); +$ar->[0] = \$ar->[1]; +$ar->[1] = \$ar->[0]; +$x = \$y; +$y = \$x; + +my @tests = ( + sub { eq_or_diff [ \"a", \"b" ], [ \"a", \"b" ] }, + sub { eq_or_diff $ar, [ $x, $y ] }, +); + +plan tests => scalar @tests; + +$_->() for @tests; diff --git a/t/test.t b/t/test.t new file mode 100644 index 0000000..fcabccf --- /dev/null +++ b/t/test.t @@ -0,0 +1,20 @@ +use Test::More; + +use Test::Differences; + +my @tests = ( + sub { eq_or_diff "a", "b" }, + sub { eq_or_diff "a\nb\nc\n", "a\nc\n" }, + sub { eq_or_diff "a\nb\nc\n", "a\nB\nc\n" }, + sub { eq_or_diff "a\nb\nc\nd\ne\n", "a\nc\ne\n" }, + sub { eq_or_diff "a\nb\nc\nd\ne\n", "a\nb\nd\ne\n", { context => 0 } }, + sub { eq_or_diff "a\nb\nc\nd\ne\n", "a\nb\nd\ne\n", { context => 10 } }, +); + +plan tests => scalar @tests; +diag "This test misuses TODO: these TODOs are actually real tests.\n"; + +TODO: { + local $TODO = 'Deliberate misuse of TODO'; + $_->() for @tests; +} diff --git a/t/text_vs_data.t b/t/text_vs_data.t new file mode 100644 index 0000000..f468b2b --- /dev/null +++ b/t/text_vs_data.t @@ -0,0 +1,20 @@ +use Test::More; +use Test::Differences; + +# use large enough data sets that this thing chooses context => 3 instead +# of "full document context". +my $a = ( "\n" x 30 ) . "a\n"; +my $b = ( "\n" x 30 ) . "b\n"; + +my @tests = ( + sub { eq_or_diff $a, $b }, + sub { eq_or_diff_text $a, $b }, + sub { eq_or_diff_data $a, $b }, +); + +plan tests => scalar @tests; + +TODO: { + local $TODO = 'Force the output to be displayed'; + $_->() for @tests; +} diff --git a/t/undef.t b/t/undef.t new file mode 100644 index 0000000..38d42a5 --- /dev/null +++ b/t/undef.t @@ -0,0 +1,30 @@ +use Test::More qw(no_plan); +use Test::Differences; + +TODO: { + local $TODO = "Should fail"; + eq_or_diff( undef, "", "undef eq ''" ); + eq_or_diff( undef, [], "undef eq []" ); + eq_or_diff( undef, 0, "undef eq 0" ); + eq_or_diff( "", 0, "'' eq 0" ); + eq_or_diff( [ 1, undef ], [ 1, "" ], "undef eq '' in array" ); + eq_or_diff( [ 1, [ 2, undef ] ], [ 1, [ 2, "" ] ], "undef eq '' in deep array" ); + eq_or_diff( [ [1], [ 2, undef ] ], [ [1], [ 2, "" ] ], "undef eq '' in AoAoS" ); + eq_or_diff( [ [1], [ 2, undef ] ], [ [1], [ 2, "" ] ], "undef eq in AoAoS" ); + eq_or_diff( [ 1, undef ], [ 1, ], "arrays of different length are equal" ); + eq_or_diff( { aa => undef }, { aa => '' }, "undef eq '' in hash" ); + eq_or_diff( { aa => undef }, { aa => '' }, "undef eq in hash" ); +} + +my $builder = Test::More->builder; +# The Test::Builder 1.5 way to do it +if ( $builder->can('history') ) { + is $builder->history->pass_count - $builder->history->todo_count, + $builder->history->literal_pass_count, + "All TODO tests failed"; +} +# The Test::Builder 0.x way to do it +else { + eq_or_diff [ map { $_->{actual_ok} } $builder->details ], [ map { 0 } $builder->details ], + "All TODO tests failed"; +}