Test-LongString-0.15/0000755000175000017500000000000011524023567013715 5ustar rafaelrafaelTest-LongString-0.15/t/0000755000175000017500000000000011524023567014160 5ustar rafaelrafaelTest-LongString-0.15/t/06lcss.t0000644000175000017500000000361211523252336015456 0ustar rafaelrafael#!perl -w use strict; use Test::More tests => 11; BEGIN { use_ok "Test::LongString" } my ($off, $len) = Test::LongString::_lcss ( "xyzzx", "abcxyzefg" ); my $longest = substr('xyzzx', $off, $len); is ( $longest, "xyz", "xyzzx vs abcxyzefg" ); ($off, $len) = Test::LongString::_lcss ( "abcxyzzx", "abcxyzefg" ); $longest = substr("abcxyzzx", $off, $len); is ( $longest, "abcxyz", "abcxyzzx vs abcxyzefg" ); ($off, $len) = Test::LongString::_lcss ( "foobar", "abcxyzefg" ); $longest = substr("foobar", $off, $len); is ( $longest, 'f', "foobar vs abcxyzefg" ); my $needle = "i pushed the lazy dog into a creek, the quick brown fox told me to"; my $haystack = "the quick brown fox jumps over the lazy dog"; ($off, $len) = Test::LongString::_lcss ( $needle, $haystack ); $longest = substr($needle, $off, $len); is ( $longest, "the quick brown fox ", "the quick brown fox" ); ($off, $len) = Test::LongString::_lcss ( $haystack, $needle ); $longest = substr($haystack, $off, $len); is ( $longest, "the quick brown fox ", "the quick brown fox (reverse args)" ); $haystack = "why did the quick brown fox jumps over the lazy dog"; ($off, $len) = Test::LongString::_lcss ( $needle, $haystack ); $longest = substr($needle, $off, $len); is ( $longest, " the quick brown fox ", "why did the quick brown fox" ); ($off, $len) = Test::LongString::_lcss ( 'ABBAGGG', 'HHHHZZAB'); $longest = substr("ABBAGGG", $off, $len); is ($longest, 'AB', 'ABBA at the beginning and end'); ($off, $len) = Test::LongString::_lcss ( 'HHHHZZAB', 'ABBAGGG'); $longest = substr("HHHHZZAB", $off, $len); is ($longest, 'AB', 'ABBA at the beginning and end (reverse args)'); ($off, $len) = Test::LongString::_lcss ( 'b', 'ab' ); $longest = substr("b", $off, $len); is($longest, 'b', 'bug in LCSS'); ($off, $len) = Test::LongString::_lcss ( "123", "ABCD" ); $longest = substr("123", $off, $len); is($longest, '', 'empty when there is no common substring'); Test-LongString-0.15/t/01teststring.t0000644000175000017500000000740211523253133016710 0ustar rafaelrafael#!perl -w use strict; use Test::More tests => 11; use Test::Builder::Tester; use Test::Builder::Tester::Color; BEGIN { use_ok "Test::LongString" } test_out("ok 1 - foo is foo"); is_string("foo", "foo", "foo is foo"); test_test("two small strings equal"); test_out("not ok 1 - foo is foo"); test_fail(6); test_diag(qq! got: "bar" # length: 3 # expected: "foo" # length: 3 # strings begin to differ at char 1 (line 1 column 1)!); is_string("bar", "foo", "foo is foo"); test_test("two small strings different"); test_out("not ok 1 - foo is foo"); test_fail(3); test_diag(qq! got: undef # expected: "foo"!); is_string(undef, "foo", "foo is foo"); test_test("got undef, expected small string"); test_out("not ok 1 - foo is foo"); test_fail(3); test_diag(qq! got: "foo" # expected: undef!); is_string("foo", undef, "foo is foo"); test_test("expected undef, got small string"); test_out("not ok 1 - long binary strings"); test_fail(6); test_diag(qq! got: "This is a long string that will be truncated by th"... # length: 70 # expected: "\\x{00}\\x{01}foo\\x{0a}bar" # length: 9 # strings begin to differ at char 1 (line 1 column 1)!); is_string( "This is a long string that will be truncated by the display() function", "\0\1foo\nbar", "long binary strings", ); test_test("display of long strings and of control chars"); test_out("not ok 1 - spelling"); test_fail(6); test_diag(qq! got: "Element" # length: 7 # expected: "El\\x{e9}ment" # length: 7 # strings begin to differ at char 3 (line 1 column 3)!); is_string( "Element", "Elément", "spelling", ); test_test("Escape high-ascii chars"); test_out('not ok 1 - foo\nfoo is foo\nfoo'); test_fail(6); test_diag(qq! got: "foo\\x{0a}foo" # length: 7 # expected: "foo\\x{0a}fpo" # length: 7 # strings begin to differ at char 6 (line 2 column 2)!); is_string("foo\nfoo", "foo\nfpo", 'foo\nfoo is foo\nfoo'); test_test("Count correctly prefix with multiline strings"); test_out("not ok 1 - this isn't Ulysses"); test_fail(6); test_diag(qq! got: ..."he bowl aloft and intoned:\\x{0a}--Introibo ad altare de"... # length: 275 # expected: ..."he bowl alift and intoned:\\x{0a}--Introibo ad altare de"... # length: 275 # strings begin to differ at char 233 (line 4 column 17)!); is_string( < 5; use Test::Builder::Tester; use Test::Builder::Tester::Color; use Test::LongString; my $DEFAULT_FLAGS = $] < 5.013005 ? '-xism' : '^'; test_out("ok 1 - foo matches foo"); like_string("foo", qr/foo/, "foo matches foo"); test_test("a small string matches"); test_out("not ok 1 - foo matches foo"); test_fail(4); test_diag(qq( got: "bar" # length: 3 # doesn't match '(?$DEFAULT_FLAGS:foo)')); like_string("bar", qr/foo/, "foo matches foo"); test_test("a small string doesn't match"); test_out("not ok 1 - foo matches foo"); test_fail(4); test_diag(qq( got: undef # length: - # doesn't match '(?$DEFAULT_FLAGS:foo)')); like_string(undef, qr/foo/, "foo matches foo"); test_test("got undef"); test_out("not ok 1 - long string matches a*"); test_fail(4); test_diag(qq( got: "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"... # length: 100 # doesn't match '(?$DEFAULT_FLAGS:^a*\$)')); like_string(("a"x60)."b".("a"x39), qr/^a*$/, "long string matches a*"); test_test("a huge string doesn't match"); test_out("not ok 1 - foo doesn't match bar"); test_fail(4); test_diag(qq( got: "bar" # length: 3 # matches '(?$DEFAULT_FLAGS:bar)')); unlike_string("bar", qr/bar/, "foo doesn't match bar"); test_test("a small string matches while it shouldn't"); Test-LongString-0.15/t/pod-coverage.t0000644000175000017500000000025411523252336016716 0ustar rafaelrafael#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); Test-LongString-0.15/t/05lacks.t0000644000175000017500000000331611523253610015603 0ustar rafaelrafael#!perl -Tw use strict; use Test::More tests => 5; use Test::Builder::Tester; use Test::Builder::Tester::Color; use Test::LongString; # In there test_out("ok 1 - Any chocolate in my peanut butter?"); lacks_string("Reese's Peanut Butter Cups", "Chocolate", "Any chocolate in my peanut butter?"); test_test("Lacking"); # Not in there test_out("not ok 1 - Any peanut butter in my chocolate?"); test_fail(4); test_diag(qq( searched: "Reese's Peanut Butter Cups")); test_diag(qq( and found: "Peanut Butter")); test_diag(qq! at position: 8 (line 1 column 9)!); lacks_string("Reese's Peanut Butter Cups", "Peanut Butter", "Any peanut butter in my chocolate?"); test_test("Not lacking"); # Multiple lines test_out("not ok 1 - Mild?"); test_fail(4); test_diag(qq( searched: "Stately, plump Buck Mulligan came from the stairhe"...)); test_diag(qq( and found: "mild")); test_diag(qq! at position: 195 (line 3 column 51)!); lacks_string(<<'EXAMPLE',"mild","Mild?"); Stately, plump Buck Mulligan came from the stairhead, bearing a bowl of lather on which a mirror and a razor lay crossed. A yellow dressinggown, ungirdled, was sustained gently behind him by the mild morning air. He held the bowl aloft and intoned: --Introibo ad altare dei. EXAMPLE test_test("Multiple lines not lacking"); # Source string undef test_out("not ok 1 - Look inside undef"); test_fail(2); test_diag(qq(String to look in is undef)); lacks_string(undef,"Orange everything", "Look inside undef"); test_test("Source string undef fails"); # Searching string undef test_out("not ok 1 - Look for undef"); test_fail(2); test_diag(qq(String to look for is undef)); lacks_string('"Fishnet" is not a color', undef, "Look for undef"); test_test("Substring undef fails"); Test-LongString-0.15/t/04contains.t0000644000175000017500000000260511523252336016327 0ustar rafaelrafael#!perl -Tw use strict; use Test::More tests => 5; use Test::Builder::Tester; use Test::Builder::Tester::Color; use Test::LongString; # In there test_out("ok 1 - What's in my dog food?"); contains_string("Dog food", "foo", "What's in my dog food?"); test_test("a small string matches"); # Not in there test_out("not ok 1 - Any nachos?"); test_fail(5); test_diag(qq( searched: "Dog food")); test_diag(qq( can't find: "Nachos")); test_diag(qq( LCSS: "o")); test_diag(qq(LCSS context: "Dog food")); contains_string("Dog food","Nachos", "Any nachos?"); test_test("Substring doesn't match (with LCSS)"); { local $Test::LongString::LCSS = 0; # Not in there, with LCSS output disabled test_out("not ok 1 - Any nachos?"); test_fail(3); test_diag(qq( searched: "Dog food")); test_diag(qq( can't find: "Nachos")); contains_string("Dog food","Nachos", "Any nachos?"); test_test("Substring doesn't match (with LCSS)"); } # Source string undef test_out("not ok 1 - Look inside undef"); test_fail(2); test_diag(qq(String to look in is undef)); contains_string(undef,"Orange everything", "Look inside undef"); test_test("Source string undef fails"); # Searching string undef test_out("not ok 1 - Look for undef"); test_fail(2); test_diag(qq(String to look for is undef)); contains_string('"Mesh" is not a color', undef, "Look for undef"); test_test("Substring undef fails"); Test-LongString-0.15/t/pod.t0000644000175000017500000000020111523252336015115 0ustar rafaelrafaeluse Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Test-LongString-0.15/t/02import.t0000644000175000017500000000077511523253133016023 0ustar rafaelrafael#!perl -w use strict; use Test::More tests => 2; use Test::Builder::Tester; use Test::Builder::Tester::Color; use Test::LongString max => 5, lcss => 0; test_out("not ok 1 - foobar is foobar"); test_fail(6); test_diag(qq! got: "foobu"... # length: 6 # expected: "fooba"... # length: 6 # strings begin to differ at char 5 (line 1 column 5)!); is_string("foobur", "foobar", "foobar is foobar"); test_test("5 chars in output"); is($Test::LongString::LCSS, 0, "\$LCSS global set"); Test-LongString-0.15/README0000644000175000017500000000101211523311704014557 0ustar rafaelrafaelTest::LongString v0.15 ====================== A library to test long strings. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES Needs Test::More, Test::Builder, and, to run the tests, Test::Builder::Tester. Test::Pod and Test::Pod::Coverage are optional. COPYRIGHT AND LICENCE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Copyright (c) 2002 - 2011 Rafael Garcia-Suarez Test-LongString-0.15/lib/0000755000175000017500000000000011524023567014463 5ustar rafaelrafaelTest-LongString-0.15/lib/Test/0000755000175000017500000000000011524023567015402 5ustar rafaelrafaelTest-LongString-0.15/lib/Test/LongString.pm0000644000175000017500000003223611523311732020025 0ustar rafaelrafaelpackage Test::LongString; use strict; use vars qw($VERSION @ISA @EXPORT $Max $Context $EOL $LCSS); $VERSION = '0.15'; use Test::Builder; my $Tester = new Test::Builder(); use Exporter; @ISA = ('Exporter'); @EXPORT = qw( is_string is_string_nows like_string unlike_string contains_string lacks_string ); # Maximum string length displayed in diagnostics $Max = 50; # Amount of context provided when starting displaying a string in the middle $Context = 10; # Boolean: should we show LCSS context ? $LCSS = 1; # Regular expression that decides what a end of line is $EOL = "\n"; sub import { (undef, my %args) = @_; $Max = $args{max} if defined $args{max}; $LCSS = $args{lcss} if defined $args{lcss}; $EOL = $args{eol} if defined $args{eol}; @_ = $_[0]; goto &Exporter::import; } # _display($string, [$offset = 0]) # Formats a string for display. Begins at $offset minus $Context. # This function ought to be configurable, ŕ la od(1). sub _display { my $s = shift; if (!defined $s) { return 'undef'; } if (length($s) > $Max) { my $offset = shift || 0; if (defined $Context) { $offset -= $Context; $offset < 0 and $offset = 0; } else { $offset = 0; } $s = sprintf(qq("%.${Max}s"...), substr($s, $offset)); $s = "...$s" if $offset; } else { $s = qq("$s"); } $s =~ s/([\0-\037\200-\377])/sprintf('\x{%02x}',ord $1)/eg; return $s; } sub _common_prefix_length { my ($str1, $str2) = @_; my $diff = $str1 ^ $str2; my ($pre) = $diff =~ /^(\000*)/; return length $pre; } sub contains_string($$;$) { my ($str,$sub,$name) = @_; my $ok; if (!defined $str) { $Tester->ok($ok = 0, $name); $Tester->diag("String to look in is undef"); } elsif (!defined $sub) { $Tester->ok($ok = 0, $name); $Tester->diag("String to look for is undef"); } else { my $index = index($str, $sub); $ok = ($index >= 0) ? 1 : 0; $Tester->ok($ok, $name); if (!$ok) { my ($g, $e) = (_display($str), _display($sub)); $Tester->diag(<diag(< 0) ? $off - ($available*2) : ($off - $available > 0) ? $off - $available : 0; my $c = _display( substr($str, $begin, $Max) ); $Tester->diag("LCSS context: $c"); } } } } return $ok; } sub _lcss($$) { my ($S, $T) = (@_); my @L; my ($offset, $length) = (0,0); # prevent us from having to zero a $ix$j matrix no warnings 'uninitialized'; # now the actual LCSS algorithm foreach my $i (0 .. length($S) ) { foreach my $j (0 .. length($T)) { if (substr($S, $i, 1) eq substr($T, $j, 1)) { if ($i == 0 or $j == 0) { $L[$i][$j] = 1; } else { $L[$i][$j] = $L[$i-1][$j-1] + 1; } if ($L[$i][$j] > $length) { $length = $L[$i][$j]; $offset = $i - $length + 1; } } } } # if you want to display just the lcss: # return substr($S, $offset, $length); # but to display the surroundings, we need to: return ($offset, $length); } sub lacks_string($$;$) { my ($str,$sub,$name) = @_; my $ok; if (!defined $str) { $Tester->ok($ok = 0, $name); $Tester->diag("String to look in is undef"); } elsif (!defined $sub) { $Tester->ok($ok = 0, $name); $Tester->diag("String to look for is undef"); } else { my $index = index($str, $sub); $ok = ($index < 0) ? 1 : 0; $Tester->ok($ok, $name); if (!$ok) { my ($g, $e) = (_display($str), _display($sub)); my $line = () = substr($str,0,$index-1) =~ /$EOL/g; my $column = $line ? $index - $+[0] + 1: $index + 1; $line++; $Tester->diag(<ok($ok, $name); if (!$ok) { my ($g, $e) = (_display($got), _display($expected)); $Tester->diag(<ok(1, $name); return 1; } else { $Tester->ok(0, $name); my $common_prefix = _common_prefix_length($got,$expected); my ($g, $e) = ( _display($got, $common_prefix), _display($expected, $common_prefix), ); my $line = () = substr($expected,0,$common_prefix) =~ /$EOL/g; my $column = $line ? $common_prefix - $+[0] + 1 : $common_prefix + 1; $line++; $Tester->diag(<ok($ok, $name); if (!$ok) { my ($g, $e) = (_display($got), _display($expected)); $Tester->diag(<ok(1, $name); return 1; } else { $Tester->ok(0, $name); my $common_prefix = _common_prefix_length($got_nows,$expected_nows); my ($g, $e) = ( _display($got_nows, $common_prefix), _display($expected_nows, $common_prefix), ); $Tester->diag(<maybe_regex($regex); unless (defined $usable_regex) { $ok = $Tester->ok( 0, $name ); $Tester->diag(" '$regex' doesn't look much like a regex to me."); return $ok; } { local $^W = 0; my $test = $got =~ /$usable_regex/ ? 1 : 0; $test = !$test if $cmp eq '!~'; $ok = $Tester->ok( $test, $name ); } unless( $ok ) { my $g = _display($got); my $match = $cmp eq '=~' ? "doesn't match" : "matches"; my $l = defined $got ? length $got : '-'; $Tester->diag(sprintf(< 1; use Test::LongString; like_string( $html, qr/(perl|cpan)\.org/ ); # Failed test (html-test.t at line 12) # got: ", but which are more suitable when you test against long strings. If you've ever had to search for text in a multi-line string like an HTML document, or find specific items in binary data, this is the module for you. =head1 FUNCTIONS =head2 is_string( $string, $expected [, $label ] ) C is equivalent to C, but with more helpful diagnostics in case of failure. =over =item * It doesn't print the entire strings in the failure message. =item * It reports the lengths of the strings that have been compared. =item * It reports the length of the common prefix of the strings. =item * It reports the line and column the strings started to differ on. =item * In the diagnostics, non-ASCII characters are escaped as C<\x{xx}>. =back For example: is_string( $soliloquy, $juliet ); # Failed test (soliloquy.t at line 15) # got: "To be, or not to be: that is the question:\x{0a}Whether"... # length: 1490 # expected: "O Romeo, Romeo,\x{0a}wherefore art thou Romeo?\x{0a}Deny thy"... # length: 154 # strings begin to differ at char 1 (line 1 column 1) =head2 is_string_nows( $string, $expected [, $label ] ) Like C, but removes whitepace (in the C<\s> sense) from the arguments before comparing them. =head2 like_string( $string, qr/regex/ [, $label ] ) =head2 unlike_string( $string, qr/regex/ [, $label ] ) C and C are replacements for C and C that only print the beginning of the received string in the output. Unfortunately, they can't print out the position where the regex failed to match. like_string( $soliloquy, qr/Romeo|Juliet|Mercutio|Tybalt/ ); # Failed test (soliloquy.t at line 15) # got: "To be, or not to be: that is the question:\x{0a}Whether"... # length: 1490 # doesn't match '(?-xism:Romeo|Juliet|Mercutio|Tybalt)' =head2 contains_string( $string, $substring [, $label ] ) C searches for I<$substring> in I<$string>. It's the same as C, except that it's not a regular expression search. contains_string( $soliloquy, "Romeo" ); # Failed test (soliloquy.t at line 10) # searched: "To be, or not to be: that is the question:\x{0a}Whether"... # and can't find: "Romeo" As of version 0.12, C will also report the Longest Common SubString (LCSS) found in I<$string> and, if the LCSS is short enough, the surroundings will also be shown under I. This should help debug tests for really long strings like HTML output, so you'll get something like: contains_string( $html, '
' ); # Failed test at t/foo.t line 10. # searched: "" # LCSS: "ainContent"" # LCSS context: "dolor sit amet\x{0a}
, and can be set at run-time. You can also set it by specifying an argument to C: use Test::LongString max => 100; When the compared strings begin to differ after a large prefix, Test::LongString will not print them from the beginning, but will start at the middle, more precisely at C<$Test::LongString::Context> characters before the first difference. By default this value is 10 characters. If you want Test::LongString to always print the beginning of compared strings no matter where they differ, undefine C<$Test::LongString::Context>. When computing line numbers this module uses "\n" to count line endings. This may not be appropriate for strings on your platform, and can be overriden by setting the C<$Test::LongString::EOL> variable to a suitable regular expression (either a reference to a regular expression or a string that can be interpolated into a regular expression.) You can also set it by specifying an argument to C: use Test::LongString eol => "\x{0a}\x{0c}"; =head1 AUTHOR Written by Rafael Garcia-Suarez. Thanks to Mark Fowler (and to Joss Whedon) for the inspirational L. Thanks to Andy Lester for lots of patches. This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. A git repository for this module is available at git://github.com/rgs/Test-LongString.git =head1 SEE ALSO L, L, L. =cut Test-LongString-0.15/MANIFEST0000644000175000017500000000040011523252336015035 0ustar rafaelrafaellib/Test/LongString.pm Makefile.PL MANIFEST MANIFEST.SKIP README t/01teststring.t t/02import.t t/03like.t t/04contains.t t/05lacks.t t/06lcss.t t/pod.t t/pod-coverage.t Changes META.yml Module meta-data (added by MakeMaker) Test-LongString-0.15/MANIFEST.SKIP0000644000175000017500000000032211523252336015605 0ustar rafaelrafael# Avoid version control files. \B\.svn\b \B\.git\b # Avoid Makemaker generated and utility files. ^MANIFEST\.bak ^Makefile$ ^blib/ ^MakeMaker-\d ^pm_to_blib$ # Avoid temp and backup files. ~$ \.old$ \#$ ^\.# Test-LongString-0.15/META.yml0000644000175000017500000000110011524023567015156 0ustar rafaelrafael--- #YAML:1.0 name: Test-LongString version: 0.15 abstract: ~ author: - Rafael Garcia-Suarez license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Test::Builder: 0.12 Test::Builder::Tester: 1.04 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.55_02 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Test-LongString-0.15/Changes0000644000175000017500000000077611523311765015221 0ustar rafaelrafael0.08 Fix and improve diagostics 0.09 Add an is_string_nows() function (RT #14018) 0.10 Better implementation of _common_prefix_length by Tassilo von Parseval 0.11 Require a more recent Test::Builder::Tester, since tests fail with 1.03. 0.12 Show longest common substring in diagnostics (Breno G. de Oliveira) 0.13 Allow to display LCSS output in diagnostics 0.14 Compatibility fix with perl 5.13.5 0.15 Show line and column number in diagostics (Mark Fowler) Test-LongString-0.15/Makefile.PL0000644000175000017500000000046511523252336015671 0ustar rafaelrafaeluse ExtUtils::MakeMaker; WriteMakefile( AUTHOR => 'Rafael Garcia-Suarez ', NAME => "Test::LongString", VERSION_FROM => "lib/Test/LongString.pm", PREREQ_PM => { 'Test::Builder' => 0.12, 'Test::Builder::Tester' => 1.04, }, LICENSE => 'perl', );