r51919 - in /branches/upstream/libtest-longstring-perl/current: Changes MANIFEST META.yml lib/Test/LongString.pm t/02import.t t/04contains.t t/06lcss.t
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Sun Jan 31 12:55:13 UTC 2010
Author: angelabad-guest
Date: Sun Jan 31 12:55:06 2010
New Revision: 51919
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=51919
Log:
[svn-upgrade] Integrating new upstream version, libtest-longstring-perl (0.13)
Added:
branches/upstream/libtest-longstring-perl/current/t/06lcss.t
Modified:
branches/upstream/libtest-longstring-perl/current/Changes
branches/upstream/libtest-longstring-perl/current/MANIFEST
branches/upstream/libtest-longstring-perl/current/META.yml
branches/upstream/libtest-longstring-perl/current/lib/Test/LongString.pm
branches/upstream/libtest-longstring-perl/current/t/02import.t
branches/upstream/libtest-longstring-perl/current/t/04contains.t
Modified: branches/upstream/libtest-longstring-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-longstring-perl/current/Changes?rev=51919&op=diff
==============================================================================
--- branches/upstream/libtest-longstring-perl/current/Changes (original)
+++ branches/upstream/libtest-longstring-perl/current/Changes Sun Jan 31 12:55:06 2010
@@ -15,3 +15,6 @@
0.12
Show longest common substring in diagnostics
(Breno G. de Oliveira)
+
+0.13
+ Allow to display LCSS output in diagnostics
Modified: branches/upstream/libtest-longstring-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-longstring-perl/current/MANIFEST?rev=51919&op=diff
==============================================================================
--- branches/upstream/libtest-longstring-perl/current/MANIFEST (original)
+++ branches/upstream/libtest-longstring-perl/current/MANIFEST Sun Jan 31 12:55:06 2010
@@ -8,6 +8,7 @@
t/03like.t
t/04contains.t
t/05lacks.t
+t/06lcss.t
t/pod.t
t/pod-coverage.t
Changes
Modified: branches/upstream/libtest-longstring-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-longstring-perl/current/META.yml?rev=51919&op=diff
==============================================================================
--- branches/upstream/libtest-longstring-perl/current/META.yml (original)
+++ branches/upstream/libtest-longstring-perl/current/META.yml Sun Jan 31 12:55:06 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Test-LongString
-version: 0.12
+version: 0.13
abstract: ~
license: perl
author:
Modified: branches/upstream/libtest-longstring-perl/current/lib/Test/LongString.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-longstring-perl/current/lib/Test/LongString.pm?rev=51919&op=diff
==============================================================================
--- branches/upstream/libtest-longstring-perl/current/lib/Test/LongString.pm (original)
+++ branches/upstream/libtest-longstring-perl/current/lib/Test/LongString.pm Sun Jan 31 12:55:06 2010
@@ -1,9 +1,9 @@
package Test::LongString;
use strict;
-use vars qw($VERSION @ISA @EXPORT $Max $Context);
-
-$VERSION = '0.12';
+use vars qw($VERSION @ISA @EXPORT $Max $Context $LCSS);
+
+$VERSION = '0.13';
use Test::Builder;
my $Tester = new Test::Builder();
@@ -19,9 +19,13 @@
# Amount of context provided when starting displaying a string in the middle
$Context = 10;
+# Boolean: should we show LCSS context ?
+$LCSS = 1;
+
sub import {
(undef, my %args) = @_;
$Max = $args{max} if defined $args{max};
+ $LCSS = $args{lcss} if defined $args{lcss};
@_ = $_[0];
goto &Exporter::import;
}
@@ -76,27 +80,31 @@
if (!$ok) {
my ($g, $e) = (_display($str), _display($sub));
- # if _lcss() returned the actual substring,
- # all we'd have to do is:
- # my $l = _display( _lcss($str, $sub) );
-
- my ($off, $len) = _lcss($str, $sub);
- my $l = _display( substr($str, $off, $len) );
-
$Tester->diag(<<DIAG);
searched: $g
can't find: $e
+DIAG
+
+ if ($LCSS) {
+ # if _lcss() returned the actual substring,
+ # all we'd have to do is:
+ # my $l = _display( _lcss($str, $sub) );
+
+ my ($off, $len) = _lcss($str, $sub);
+ my $l = _display( substr($str, $off, $len) );
+
+ $Tester->diag(<<DIAG);
LCSS: $l
DIAG
-
- # if there's room left, show some surrounding context
- if ($len < $Max) {
- my $available = int( ($Max - $len) / 2 );
- my $begin = ($off - ($available*2) > 0) ? $off - ($available*2)
- : ($off - $available > 0) ? $off - $available : 0;
- my $c = _display( substr($str, $begin, $Max) );
-
- $Tester->diag("LCSS context: $c");
+ # if there's room left, show some surrounding context
+ if ($len < $Max) {
+ my $available = int( ($Max - $len) / 2 );
+ my $begin = ($off - ($available*2) > 0) ? $off - ($available*2)
+ : ($off - $available > 0) ? $off - $available : 0;
+ my $c = _display( substr($str, $begin, $Max) );
+
+ $Tester->diag("LCSS context: $c");
+ }
}
}
}
@@ -373,6 +381,23 @@
# 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<contains_string()> 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<LCSS Context>. This should help debug
+tests for really long strings like HTML output, so you'll get something like:
+
+ contains_string( $html, '<div id="MainContent">' );
+ # Failed test at t/foo.t line 10.
+ # searched: "<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Stric"...
+ # can't find: "<div id="MainContent">"
+ # LCSS: "ainContent""
+ # LCSS context: "dolor sit amet</span>\x{0a}<div id="mainContent" class="
+
+You can turn off LCSS reporting by setting C<$Test::LongString::LCSS> to 0,
+or by specifying an argument to C<use>:
+
+ use Test::LongString lcss => 0;
+
=head2 lacks_string( $string, $substring [, $label ] )
C<lacks_string()> makes sure that I<$substring> does NOT exist in
Modified: branches/upstream/libtest-longstring-perl/current/t/02import.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-longstring-perl/current/t/02import.t?rev=51919&op=diff
==============================================================================
--- branches/upstream/libtest-longstring-perl/current/t/02import.t (original)
+++ branches/upstream/libtest-longstring-perl/current/t/02import.t Sun Jan 31 12:55:06 2010
@@ -2,10 +2,10 @@
use strict;
-use Test::More tests => 1;
+use Test::More tests => 2;
use Test::Builder::Tester;
use Test::Builder::Tester::Color;
-use Test::LongString max => 5;
+use Test::LongString max => 5, lcss => 0;
test_out("not ok 1 - foobar is foobar");
test_fail(6);
@@ -16,3 +16,5 @@
# strings begin to differ at char 5));
is_string("foobur", "foobar", "foobar is foobar");
test_test("5 chars in output");
+
+is($Test::LongString::LCSS, 0, "\$LCSS global set");
Modified: branches/upstream/libtest-longstring-perl/current/t/04contains.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-longstring-perl/current/t/04contains.t?rev=51919&op=diff
==============================================================================
--- branches/upstream/libtest-longstring-perl/current/t/04contains.t (original)
+++ branches/upstream/libtest-longstring-perl/current/t/04contains.t Sun Jan 31 12:55:06 2010
@@ -2,7 +2,7 @@
use strict;
-use Test::More tests => 4;
+use Test::More tests => 5;
use Test::Builder::Tester;
use Test::Builder::Tester::Color;
use Test::LongString;
@@ -20,7 +20,18 @@
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 LCS)");
+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");
@@ -35,5 +46,3 @@
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");
-
-
Added: branches/upstream/libtest-longstring-perl/current/t/06lcss.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-longstring-perl/current/t/06lcss.t?rev=51919&op=file
==============================================================================
--- branches/upstream/libtest-longstring-perl/current/t/06lcss.t (added)
+++ branches/upstream/libtest-longstring-perl/current/t/06lcss.t Sun Jan 31 12:55:06 2010
@@ -1,0 +1,51 @@
+#!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');
More information about the Pkg-perl-cvs-commits
mailing list