diff options
author | Aristotle Pagaltzis <pagaltzis@gmx.de> | 2021-08-05 19:20:34 +0000 |
---|---|---|
committer | James E Keenan <jkeenan@cpan.org> | 2021-08-05 19:24:01 +0000 |
commit | 9a679b438a9b511b702a547c18003c662c3c012c (patch) | |
tree | 79b8fd6f0533b856314c1283a1d42c4cdfa7b284 /cpan/Text-Tabs | |
parent | 89dbbd9d95480b12bca13906bb1aee4323ced0e1 (diff) | |
download | perl-9a679b438a9b511b702a547c18003c662c3c012c.tar.gz |
Text-Tabs+Wrap: Sync with CPAN version 2021.0804
From upstream CHANGELOG:
* Explicitly declared strictures and warnings everywhere (to support
-Dusedefaultstrict perls)
* Makefile.PL fixes
* Unicode support on all supported versions of Perl
* Full strict and warnings cleanliness
* Packaging cleanups
* Removal of reference benchmark from test suite (moved to xt/bench)
Committer: Manual verification of the procedure Aristotle used in
https://github.com/Perl/perl5/pull/19026.
Diffstat (limited to 'cpan/Text-Tabs')
-rw-r--r-- | cpan/Text-Tabs/lib/Text/Tabs.pm | 79 | ||||
-rw-r--r-- | cpan/Text-Tabs/lib/Text/Wrap.pm | 66 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/37000.t | 17 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/39548.t | 15 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/79766.t | 7 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/Jacobson.t | 13 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/Jacobson2.t | 11 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/Jochen.t | 5 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/Tabs-ElCid.t | 21 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/Wrap-JLB.t | 21 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/belg4mit.t | 5 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/dandv.t | 14 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/dnsparks.t | 151 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/fill.t | 51 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/lib/ok.pl | 4 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/sep.t | 63 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/sep2.t | 63 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/tabs.t | 44 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/wrap.t | 67 | ||||
-rw-r--r-- | cpan/Text-Tabs/t/wrap_separator2.t | 6 |
20 files changed, 149 insertions, 574 deletions
diff --git a/cpan/Text-Tabs/lib/Text/Tabs.pm b/cpan/Text-Tabs/lib/Text/Tabs.pm index 5deb2dd198..101378c2ac 100644 --- a/cpan/Text-Tabs/lib/Text/Tabs.pm +++ b/cpan/Text-Tabs/lib/Text/Tabs.pm @@ -1,29 +1,15 @@ -no strict; no warnings; +use strict; use warnings; package Text::Tabs; -require Exporter; +BEGIN { require Exporter; *import = \&Exporter::import } -@ISA = (Exporter); -@EXPORT = qw(expand unexpand $tabstop); +our @EXPORT = qw( expand unexpand $tabstop ); -use vars qw($VERSION $SUBVERSION $tabstop $debug); -$VERSION = '2021.0717'; -$SUBVERSION = 'modern'; +our $VERSION = '2021.0804'; +our $SUBVERSION = 'modern'; # back-compat vestige -use strict; - -use 5.010_000; - -BEGIN { - $tabstop = 8; - $debug = 0; -} - -my $CHUNK = qr/\X/; - -sub _xlen (_) { scalar(() = $_[0] =~ /$CHUNK/g) } -sub _xpos (_) { _xlen( substr( $_[0], 0, pos($_[0]) ) ) } +our $tabstop = 8; sub expand { my @l; @@ -31,16 +17,15 @@ sub expand { for ( @_ ) { my $s = ''; for (split(/^/m, $_, -1)) { - my $offs = 0; - s{\t}{ - # this works on both 5.10 and 5.11 - $pad = $tabstop - (_xlen(${^PREMATCH}) + $offs) % $tabstop; - # this works on 5.11, but fails on 5.10 - #XXX# $pad = $tabstop - (_xpos() + $offs) % $tabstop; - $offs += $pad - 1; - " " x $pad; - }peg; - $s .= $_; + my $offs; + for (split(/\t/, $_, -1)) { + if (defined $offs) { + $pad = $tabstop - $offs % $tabstop; + $s .= " " x $pad; + } + $s .= $_; + $offs = () = /\PM/g; + } } push(@l, $s); } @@ -61,18 +46,13 @@ sub unexpand @lines = split("\n", $x, -1); for $line (@lines) { $line = expand($line); - @e = split(/(${CHUNK}{$tabstop})/,$line,-1); + @e = split(/((?:\PM\pM*){$tabstop})/,$line,-1); $lastbit = pop(@e); $lastbit = '' unless defined $lastbit; $lastbit = "\t" if $lastbit eq $ts_as_space; for $_ (@e) { - if ($debug) { - my $x = $_; - $x =~ s/\t/^I\t/gs; - print "sub on '$x'\n"; - } s/ +$/\t/; } $line = join('',@e, $lastbit); @@ -84,22 +64,8 @@ sub unexpand } 1; -__END__ - -sub expand -{ - my (@l) = @_; - for $_ (@l) { - 1 while s/(^|\n)([^\t\n]*)(\t+)/ - $1. $2 . (" " x - ($tabstop * length($3) - - (length($2) % $tabstop))) - /sex; - } - return @l if wantarray; - return $l[0]; -} +__END__ =head1 NAME @@ -166,17 +132,6 @@ Instead of the shell's C<unexpand -a> command, use: perl -MText::Tabs -n -e 'print unexpand $_' -=head1 SUBVERSION - -This module comes in two flavors: one for modern perls (5.10 and above) -and one for ancient obsolete perls. The version for modern perls has -support for Unicode. The version for old perls does not. You can tell -which version you have installed by looking at C<$Text::Tabs::SUBVERSION>: -it is C<old> for obsolete perls and C<modern> for current perls. - -This man page is for the version for modern perls and so that's probably -what you've got. - =head1 BUGS Text::Tabs handles only tabs (C<"\t">) and combining characters (C</\pM/>). It doesn't diff --git a/cpan/Text-Tabs/lib/Text/Wrap.pm b/cpan/Text-Tabs/lib/Text/Wrap.pm index a91811a02b..80dc990975 100644 --- a/cpan/Text-Tabs/lib/Text/Wrap.pm +++ b/cpan/Text-Tabs/lib/Text/Wrap.pm @@ -1,38 +1,26 @@ -no strict; no warnings; +use strict; use warnings; package Text::Wrap; use warnings::register; -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(wrap fill); -@EXPORT_OK = qw($columns $break $huge); +BEGIN { require Exporter; *import = \&Exporter::import } -$VERSION = '2021.0717'; -$SUBVERSION = 'modern'; +our @EXPORT = qw( wrap fill ); +our @EXPORT_OK = qw( $columns $break $huge ); -use 5.010_000; +our $VERSION = '2021.0804'; +our $SUBVERSION = 'modern'; # back-compat vestige -use vars qw($VERSION $SUBVERSION $columns $debug $break $huge $unexpand $tabstop $separator $separator2); -use strict; +our $columns = 76; # <= screen width +our $break = '(?=\s)(?:\r\n|\PM\pM*)'; +our $huge = 'wrap'; # alternatively: 'die' or 'overflow' +our $unexpand = 1; +our $tabstop = 8; +our $separator = "\n"; +our $separator2 = undef; -BEGIN { - $columns = 76; # <= screen width - $debug = 0; - $break = '(?=\s)\X'; - $huge = 'wrap'; # alternatively: 'die' or 'overflow' - $unexpand = 1; - $tabstop = 8; - $separator = "\n"; - $separator2 = undef; -} - -my $CHUNK = qr/\X/; - -sub _xlen(_) { scalar(() = $_[0] =~ /$CHUNK/g) } - -sub _xpos(_) { _xlen( substr( $_[0], 0, pos($_[0]) ) ) } +sub _xlen { () = $_[0] =~ /\PM/g } use Text::Tabs qw(expand unexpand); @@ -61,17 +49,17 @@ sub wrap pos($t) = 0; while ($t !~ /\G(?:$break)*\Z/gc) { - if ($t =~ /\G((?:(?=[^\n])\X){0,$ll})($break|\n+|\z)/xmgc) { + if ($t =~ /\G((?:(?!\n)\PM\pM*){0,$ll})($break|\n+|\z)/xmgc) { $r .= $unexpand ? unexpand($nl . $lead . $1) : $nl . $lead . $1; $remainder = $2; - } elsif ($huge eq 'wrap' && $t =~ /\G((?:(?=[^\n])\X){$ll})/gc) { + } elsif ($huge eq 'wrap' && $t =~ /\G((?:(?!\n)\PM\pM*){$ll})/gc) { $r .= $unexpand ? unexpand($nl . $lead . $1) : $nl . $lead . $1; $remainder = defined($separator2) ? $separator2 : $separator; - } elsif ($huge eq 'overflow' && $t =~ /\G((?:(?=[^\n])\X)*?)($break|\n+|\z)/xmgc) { + } elsif ($huge eq 'overflow' && $t =~ /\G((?:(?!\n)\PM\pM*)*?)($break|\n+|\z)/xmgc) { $r .= $unexpand ? unexpand($nl . $lead . $1) : $nl . $lead . $1; @@ -96,17 +84,9 @@ sub wrap } $r .= $remainder; - print "-----------$r---------\n" if $debug; - - print "Finish up with '$lead'\n" if $debug; - - my($opos) = pos($t); - $r .= $lead . substr($t, pos($t), length($t) - pos($t)) if pos($t) ne length($t); - print "-----------$r---------\n" if $debug;; - return $r; } @@ -130,6 +110,7 @@ sub fill } 1; + __END__ =head1 NAME @@ -271,17 +252,6 @@ Result: "This is a bit of|text that forms a|normal book-style|paragraph" -=head1 SUBVERSION - -This module comes in two flavors: one for modern perls (5.10 and above) -and one for ancient obsolete perls. The version for modern perls has -support for Unicode. The version for old perls does not. You can tell -which version you have installed by looking at C<$Text::Wrap::SUBVERSION>: -it is C<old> for obsolete perls and C<modern> for current perls. - -This man page is for the version for modern perls and so that's probably -what you've got. - =head1 SEE ALSO For correct handling of East Asian half- and full-width characters, diff --git a/cpan/Text-Tabs/t/37000.t b/cpan/Text-Tabs/t/37000.t index f08999e926..13416f561a 100644 --- a/cpan/Text-Tabs/t/37000.t +++ b/cpan/Text-Tabs/t/37000.t @@ -1,9 +1,10 @@ use strict; use warnings; -#Causes Text::Wrap to die... - +BEGIN { require './t/lib/ok.pl' } use Text::Wrap; +#Causes Text::Wrap to die... + my $toPrint = "(1) Category\t(2 or greater) New Category\n\n"; my $good = "(1) Category\t(2 or greater) New Category\n"; @@ -11,16 +12,16 @@ print "1..6\n"; local($Text::Wrap::break) = '\s'; eval { $toPrint = wrap("","",$toPrint); }; -print $@ ? "not ok 1\n" : "ok 1\n"; -print $toPrint eq $good ? "ok 2\n" : "not ok 2\n"; +ok( !$@ ); +ok( $toPrint eq $good ); local($Text::Wrap::break) = '\d'; eval { $toPrint = wrap("","",$toPrint); }; -print $@ ? "not ok 3\n" : "ok 3\n"; -print $toPrint eq $good ? "ok 4\n" : "not ok 4\n"; +ok( !$@ ); +ok( $toPrint eq $good ); local($Text::Wrap::break) = 'a'; eval { $toPrint = wrap("","",$toPrint); }; -print $@ ? "not ok 5\n" : "ok 5\n"; -print $toPrint eq $good ? "ok 6\n" : "not ok 6\n"; +ok( !$@ ); +ok( $toPrint eq $good ); diff --git a/cpan/Text-Tabs/t/39548.t b/cpan/Text-Tabs/t/39548.t index 8322867c57..e8aebe59ac 100644 --- a/cpan/Text-Tabs/t/39548.t +++ b/cpan/Text-Tabs/t/39548.t @@ -1,11 +1,14 @@ -no strict; use warnings; +use strict; use warnings; + +BEGIN { require './t/lib/ok.pl' } +use Text::Wrap; # https://rt.perl.org/rt3/Ticket/Display.html?id=39548 print "1..1\n"; -require Text::Wrap; -$VAR1 = " (Karl-Bonhoeffer-Nervenklinik zwischen Hermann-Piper-Str. und U-Bahnhof) "; -$VAR2 = " "; -$VAR3 = "(5079,19635 5124,19634 5228,19320 5246,19244)\n"; + +my $VAR1 = " (Karl-Bonhoeffer-Nervenklinik zwischen Hermann-Piper-Str. und U-Bahnhof) "; +my $VAR2 = " "; +my $VAR3 = "(5079,19635 5124,19634 5228,19320 5246,19244)\n"; eval { Text::Wrap::wrap($VAR1,$VAR2,$VAR3); }; -print $@ ? "not ok 1\n" : "ok 1\n"; +ok( !$@ ); diff --git a/cpan/Text-Tabs/t/79766.t b/cpan/Text-Tabs/t/79766.t index 09029a5851..ef546e120a 100644 --- a/cpan/Text-Tabs/t/79766.t +++ b/cpan/Text-Tabs/t/79766.t @@ -1,16 +1,17 @@ use strict; use warnings; +BEGIN { require './t/lib/ok.pl' } use Text::Wrap; -use Test::More tests => 2; + +print "1..2\n"; my $r; my $s = q{xx xxxxxxxx xxxxxxxxx xx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx=xxxxxxxxxxxxxxxxxxxxxxxx}; eval { $r = wrap("", "", $s) }; ok(! $@, $@); -is($r, "xx xxxxxxxx xxxxxxxxx xx +ok($r eq "xx xxxxxxxx xxxxxxxxx xx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx=xxxxxxxxxxxxx xxxxxxxxxxx", "match"); - diff --git a/cpan/Text-Tabs/t/Jacobson.t b/cpan/Text-Tabs/t/Jacobson.t index 2cf1da3f72..0c9c9cd65f 100644 --- a/cpan/Text-Tabs/t/Jacobson.t +++ b/cpan/Text-Tabs/t/Jacobson.t @@ -1,14 +1,13 @@ -no strict; use warnings; +use strict; use warnings; -# From: Dan Jacobson <jidanni at jidanni dot org> - -use Text::Wrap qw(wrap $columns $huge $break); +BEGIN { require './t/lib/ok.pl' } +use Text::Wrap; print "1..1\n"; -$huge='overflow'; +$Text::Wrap::huge='overflow'; $Text::Wrap::columns=9; -$break=".(?<=[,.])"; +$Text::Wrap::break=".(?<=[,.])"; eval { $a=$a=wrap('','', "mmmm,n,ooo,ppp.qqqq.rrrrr,sssssssssssss,ttttttttt,uu,vvv wwwwwwwww####\n"); @@ -19,6 +18,6 @@ if ($@) { $e =~ s/^/# /gm; print $e; } -print $@ ? "not ok 1\n" : "ok 1\n"; +ok( !$@ ); diff --git a/cpan/Text-Tabs/t/Jacobson2.t b/cpan/Text-Tabs/t/Jacobson2.t index cf3142d635..b6a9e19f87 100644 --- a/cpan/Text-Tabs/t/Jacobson2.t +++ b/cpan/Text-Tabs/t/Jacobson2.t @@ -1,12 +1,13 @@ -no strict; no warnings; +use strict; use warnings; -use Text::Wrap qw(wrap $columns $huge $break); +BEGIN { require './t/lib/ok.pl' } +use Text::Wrap; print "1..1\n"; -$huge='overflow'; +$Text::Wrap::huge='overflow'; $Text::Wrap::columns=9; -$break=".(?<=[,.])"; +$Text::Wrap::break=".(?<=[,.])"; eval { $a=$a=wrap('','', "mmmm,n,ooo,ppp.qqqq.rrrrr.adsljasdf\nlasjdflajsdflajsdfljasdfl\nlasjdflasjdflasf,sssssssssssss,ttttttttt,uu,vvv wwwwwwwww####\n"); @@ -17,6 +18,6 @@ if ($@) { $e =~ s/^/# /gm; print $e; } -print $@ ? "not ok 1\n" : "ok 1\n"; +ok( !$@ ); diff --git a/cpan/Text-Tabs/t/Jochen.t b/cpan/Text-Tabs/t/Jochen.t index a103c95478..8b113451e5 100644 --- a/cpan/Text-Tabs/t/Jochen.t +++ b/cpan/Text-Tabs/t/Jochen.t @@ -1,5 +1,6 @@ -use strict; no warnings; +use strict; use warnings; +BEGIN { require './t/lib/ok.pl' } use Text::Wrap; print "1..1\n"; @@ -7,5 +8,5 @@ print "1..1\n"; $Text::Wrap::columns = 1; eval { wrap('', '', ''); }; -print $@ ? "not ok 1\n" : "ok 1\n"; +ok( !$@ ); diff --git a/cpan/Text-Tabs/t/Tabs-ElCid.t b/cpan/Text-Tabs/t/Tabs-ElCid.t index d2ee7ff078..0f554afa3f 100644 --- a/cpan/Text-Tabs/t/Tabs-ElCid.t +++ b/cpan/Text-Tabs/t/Tabs-ElCid.t @@ -1,11 +1,6 @@ use strict; use warnings FATAL => 'all'; -BEGIN { - if ($] <= 5.010) { - print "1..0 # skip this test requires perl 5.010 or greater ($])\n"; - exit 0; - } -} +BEGIN { eval sprintf 'sub NEED_REPEATED_DECODE () { %d }', $] lt '5.008' } use Text::Tabs; @@ -55,7 +50,7 @@ our @DATA = ( }, ); -$| = 1; + my $numtests = @DATA; print "1..$numtests\n"; @@ -103,9 +98,9 @@ sub check($$$$) { sub check_data { - binmode(DATA, ":utf8") || die "can't binmode DATA to utf8: $!"; local($_); while ( <DATA> ) { + $_ = pack "U0a*", $_; my $bad = 0; @@ -119,8 +114,8 @@ sub check_data { $byte_count = bytes::length($_); $char_count = length(); - $chunk_count = () = /\X/g; - $word_count = () = /(?:(?=\pL)\X)+/g; + $chunk_count = () = /\PM/g; + $word_count = () = /(?:\pL\pM*)+/g; $tab_count = y/\t//; $bad++ unless check($byte_count, $., "OLD", "BYTES"); @@ -130,13 +125,14 @@ sub check_data { $bad++ unless check($tab_count, $., "OLD", "TABS"); $_ = expand($_); + $_ = pack "U0a*", $_ if NEED_REPEATED_DECODE; $DATA[$.]{NEW}{DATA} = $_; $byte_count = bytes::length($_); $char_count = length(); - $chunk_count = () = /\X/g; - $word_count = () = /(?:(?=\pL)\X)+/g; + $chunk_count = () = /\PM/g; + $word_count = () = /(?:\pL\pM*)+/g; $tab_count = y/\t//; $bad++ unless check($byte_count, $., "NEW", "BYTES"); @@ -146,6 +142,7 @@ sub check_data { $bad++ unless check($tab_count, $., "NEW", "TABS"); $_ = unexpand($_); + $_ = pack "U0a*", $_ if NEED_REPEATED_DECODE; if ($_ ne $DATA[$.]{OLD}{DATA}) { warn "expand/unexpand round-trip equivalency failed at line $."; diff --git a/cpan/Text-Tabs/t/Wrap-JLB.t b/cpan/Text-Tabs/t/Wrap-JLB.t index 7e7263f89a..d7ce187e30 100644 --- a/cpan/Text-Tabs/t/Wrap-JLB.t +++ b/cpan/Text-Tabs/t/Wrap-JLB.t @@ -1,11 +1,6 @@ use strict; use warnings FATAL => 'all'; -BEGIN { - if ($] <= 5.010) { - print "1..0 # skip this test requires perl 5.010 or greater\n"; - exit 0; - } -} +BEGIN { eval sprintf 'sub NEED_REPEATED_DECODE () { %d }', $] lt '5.008' } use Text::Wrap; @@ -16,7 +11,6 @@ require bytes; our $Errors = 0; $/ = q(); -binmode(DATA, ":utf8") || die "can't binmode DATA to utf8: $!"; our @DATA = ( [ # paragraph 0 @@ -40,7 +34,7 @@ our @DATA = ( }, ); -$| = 1; + my $numtests = @DATA; print "1..$numtests\n"; @@ -84,9 +78,9 @@ sub check($$$$) { sub check_data { - binmode(DATA, ":utf8") || die "can't binmode DATA to utf8: $!"; local($_); while ( <DATA> ) { + $_ = pack "U0a*", $_; my $bad = 0; @@ -100,8 +94,8 @@ sub check_data { $byte_count = bytes::length($_); $char_count = length(); - $chunk_count = () = /\X/g; - $word_count = () = /(?:(?=\pL)\X)+/g; + $chunk_count = () = /\PM/g; + $word_count = () = /(?:\pL\pM*)+/g; $tab_count = y/\t//; $line_count = y/\n//; @@ -115,11 +109,12 @@ sub check_data { my $nl = "\n" x chomp; $_ = wrap("", "", $_) . $nl; + $_ = pack "U0a*", $_ if NEED_REPEATED_DECODE; $byte_count = bytes::length($_); $char_count = length(); - $chunk_count = () = /\X/g; - $word_count = () = /(?:(?=\pL)\X)+/g; + $chunk_count = () = /\PM/g; + $word_count = () = /(?:\pL\pM*)+/g; $tab_count = y/\t//; $line_count = y/\n//; diff --git a/cpan/Text-Tabs/t/belg4mit.t b/cpan/Text-Tabs/t/belg4mit.t index b75825b702..8c1daa424c 100644 --- a/cpan/Text-Tabs/t/belg4mit.t +++ b/cpan/Text-Tabs/t/belg4mit.t @@ -1,5 +1,6 @@ -use strict; no warnings; +use strict; use warnings; +BEGIN { require './t/lib/ok.pl' } use Text::Wrap; print "1..1\n"; @@ -14,5 +15,5 @@ if ($@) { $e =~ s/^/# /gm; print $e; } -print $@ ? "not ok 1\n" : "ok 1\n"; +ok( !$@ ); diff --git a/cpan/Text-Tabs/t/dandv.t b/cpan/Text-Tabs/t/dandv.t index 6aad2eaf4a..5e664e4cf9 100644 --- a/cpan/Text-Tabs/t/dandv.t +++ b/cpan/Text-Tabs/t/dandv.t @@ -1,9 +1,11 @@ -no strict; no warnings; +use strict; use warnings; +BEGIN { require './t/lib/ok.pl' } use Text::Wrap; -use Test::More tests => 2; -$Text::Wrap::columns = 4; -eval { $x = Text::Wrap::wrap('', '123', 'some text'); }; -is($@, ''); -is($x, "some\n123t\n123e\n123x\n123t"); +print "1..2\n"; + +$Text::Wrap::columns = 4; +my $x = eval { wrap('', '123', 'some text') }; +ok(!$@); +ok($x eq "some\n123t\n123e\n123x\n123t"); diff --git a/cpan/Text-Tabs/t/dnsparks.t b/cpan/Text-Tabs/t/dnsparks.t deleted file mode 100644 index 2f8bc16454..0000000000 --- a/cpan/Text-Tabs/t/dnsparks.t +++ /dev/null @@ -1,151 +0,0 @@ -use strict; use warnings; - -BEGIN { - # XXX workaround for bleadperl smokes using PERLIO=stdio: - # - # $ PERLIO=stdio ./perl -Ilib cpan/Text-Tabs/t/dnsparks.t - # -T and -B not implemented on filehandles at cpan/Text-Tabs/t/dnsparks.t line 130 - - if ($ENV{PERLIO} eq 'stdio') { - print "1..0 # Skipped: stdio not supported\n"; - exit; - } - if ($ENV{HARNESS_ACTIVE}) { - print "1..0 # Skipped: not a regression test\n"; - exit; - } - unless (eval { require Benchmark; }) { - print "1..0 # Skipped: this test requires Benchmark.pm\n"; - exit; - } -} - -#From: dnsparks@juno.com -#Subject: Text::Wrap suggestions -#To: muir@idiom.com -#Date: Sat, 10 Feb 2001 21:50:29 -0500 -# -#David, -# -#I had a "word wrapping" problem to solve at work the other week. -#Text::Wrap would have done exactly what I needed, but at work we use -#Smalltalk. :-) (I ended up thinking about it at home, where I don't have -#Smalltalk, so I first coded it in Perl and then "translated" my solution -#at work.) -# -#I must admit that I was dealing with a specialized case; I didn't want to -#prepend any strings on the first or subsequent lines of the paragraph -#begin created. In other words, had we been using Perl at work, I would -#have done something like this: -# -# use Text::Wrap qw(wrap $columns); -# # ... set $columns, $string, etc. ... -# return wrap("", "", $string); -# -#By the way, the copy of Wrap.pm came with the IndigoPerl distribution I -#recently downloaded. This is the version string: $VERSION = 98.112902; I -#don't know if that's the most recent. -# -#When I had some time, I was curious to see how my solution compared to -#using your module. So, I threw together the following script: -# -#The interesting thing, which really surprised me, was that the results -#seemed to indicate that my version ran faster. I was surprised because -#I'm used to thinking that the standard Perl modules would always present -#a better solution than "reinventing the wheel". -# -# mine: 24 wallclock secs (18.49 usr + 0.00 sys = 18.49 CPU) @ 54.09/s -#(n=1000) -# module: 58 wallclock secs (56.44 usr + 0.02 sys = 56.46 CPU) @ 17.71/s -#(n=1000) -# -#Then, it occurred to me that the diffrence may be attributable to my -#using substr() vs. the module relying on s///. (I recall reading -#something on perlmonks.org a while back that indicated that substr() is -#often faster than s///.) -# -#I realize that my solution has its problems (doesn't include ability to -#specify first/subsequent line prefixes, and the possibility that it may -#recurse itself out of memory, given a big enough input string). But I -#though you might be interested in my findings. -# -#Dan -#(perlmonks.org nick: t'mo) - - -use Text::Wrap qw(wrap $columns); -use Benchmark; - -my $testString = 'a;kjdf;ldsjf afkjad;fkjafkjafkj; dsfljasdfkjasfj;dThis -is a test. It is only a test. Do not be alarmed, as the test should only -take several seconds to run. Yadda yadda yadda...a;kjdf;ldsjf -afkjad;fkjafkjafkj; dsfljasdfkjasfj;dThis is a test. It is only a test. -Do not be alarmed, as the test should only take several seconds to run. -Yadda yadda yadda...a;kjdf;ldsjf afkjad;fkjafkjafkj; -dsfljasdfkjasfj;dThis is a test. It is only a test. Do not be alarmed, as -the test should only take several seconds to run. Yadda yadda -yadda...a;kjdf;ldsjf afkjad;fkjafkjafkj; dsfljasdfkjasfj;dThis is a test. -It is only a test. Do not be alarmed, as the test should only take -several seconds to run. Yadda yadda yadda...' x 5; - -$columns = 55; - -sub prefix { - my $length = shift; - my $string = shift; - - return "" if( ! $string ); - - return prefix($length, substr($string, 1)) - if( $string =~ /^\s/ ); - - if( length $string <= $length ) { - chop($string) while( $string =~ /\s$/ ); - return $string . "\n"; - } - - my $pre = substr($string, 0, $length); - my $post = substr($string, $length); - - if( $pre =~ /\s$/ ) { - chop($pre) while( $pre =~ /\s$/ ); - return $pre . "\n" . prefix($length, $post); - } - else { - if( $post =~ /^\s/ ) { - return $pre . "\n" . prefix($length, $post); - } - else { - if( $pre !~ /\s/ ) { - return $pre . "\n" . prefix($length, $post); - } - else { - $pre =~ /(.*)\s+([^\s]*)/; - $post = $2 . $post; - return $1 . "\n" . prefix($length, $post); - } - } - } -} - -my $x = prefix($columns, $testString); -my $y = wrap("", "", $testString); - -unless ($x ne $y) { - print "1..0 # Skipped: dnspark's module doesn't give the same answer\n"; - exit; -} - -my $cnt = -T STDOUT ? 200 : 40; -my $results = timethese($cnt, { - mine => sub { my $res = prefix($columns, $testString) }, - module => sub { my $res = wrap("", "", $testString) }, -}, 'none'); - -if ($results->{module}[1] < $results->{mine}[1]) { - print "1..1\nok 1\n"; -} else { - print "1..0 # Skipped: Dan's implmentation is faster\n"; -} - - diff --git a/cpan/Text-Tabs/t/fill.t b/cpan/Text-Tabs/t/fill.t index c4f7b7b453..bc4a07a885 100644 --- a/cpan/Text-Tabs/t/fill.t +++ b/cpan/Text-Tabs/t/fill.t @@ -1,6 +1,9 @@ -no strict; use warnings; +use strict; use warnings; -@tests = (split(/\nEND\n/s, <<DONE)); +BEGIN { require './t/lib/ok.pl' } +use Text::Wrap; + +my @tests = (split(/\nEND\n/s, <<DONE)); TEST1 Cyberdog Information @@ -47,16 +50,9 @@ END DONE -$| = 1; - my $numtests = scalar(@tests) / 2; print "1..$numtests\n"; -use Text::Wrap; - -$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1; - -$tn = 1; while (@tests) { my $in = shift(@tests); my $out = shift(@tests); @@ -65,40 +61,5 @@ while (@tests) { my $back = fill(' ', ' ', $in); - if ($back eq $out) { - print "ok $tn\n"; - } elsif ($rerun) { - my $oi = $in; - write_file("#o", $back); - write_file("#e", $out); - foreach ($in, $back, $out) { - s/\t/^I\t/gs; - s/\n/\$\n/gs; - } - print "------------ input ------------\n"; - print $in; - print "\n------------ output -----------\n"; - print $back; - print "\n------------ expected ---------\n"; - print $out; - print "\n-------------------------------\n"; - $Text::Wrap::debug = 1; - fill(' ', ' ', $oi); - exit(1); - } else { - print "not ok $tn\n"; - } - $tn++; -} - -sub write_file -{ - my ($f, @data) = @_; - - local(*F); - - open(F, ">$f") || die "open >$f: $!"; - (print F @data) || die "write $f: $!"; - close(F) || die "close $f: $!"; - return 1; + ok( $back eq $out ); } diff --git a/cpan/Text-Tabs/t/lib/ok.pl b/cpan/Text-Tabs/t/lib/ok.pl new file mode 100644 index 0000000000..5dbeb319de --- /dev/null +++ b/cpan/Text-Tabs/t/lib/ok.pl @@ -0,0 +1,4 @@ +use strict; use warnings; +my $_t; +sub ok { print +( $_[0] ? 'ok ' : 'not ok ' ) . ++$_t . ( $_[1] ? " - $_[1]\n" : "\n" ) } +1; diff --git a/cpan/Text-Tabs/t/sep.t b/cpan/Text-Tabs/t/sep.t index 45bf4eee97..8ac2e8a49f 100644 --- a/cpan/Text-Tabs/t/sep.t +++ b/cpan/Text-Tabs/t/sep.t @@ -1,6 +1,9 @@ -no strict; no warnings; +use strict; use warnings; -@tests = (split(/\nEND\n/s, <<DONE)); +BEGIN { require './t/lib/ok.pl' } +use Text::Wrap; + +my @tests = (split(/\nEND\n/s, <<DONE)); TEST1 This is @@ -83,16 +86,11 @@ END DONE -$| = 1; - print "1..", 1 +@tests, "\n"; -use Text::Wrap; $Text::Wrap::separator = '='; -$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1; - -$tn = 1; +my @st; @st = @tests; while (@st) { @@ -103,28 +101,7 @@ while (@st) { my $back = wrap(' ', ' ', $in); - if ($back eq $out) { - print "ok $tn\n"; - } elsif ($rerun) { - my $oi = $in; - foreach ($in, $back, $out) { - s/\t/^I\t/gs; - s/\n/\$\n/gs; - } - print "------------ input ------------\n"; - print $in; - print "\n------------ output -----------\n"; - print $back; - print "\n------------ expected ---------\n"; - print $out; - print "\n-------------------------------\n"; - $Text::Wrap::debug = 1; - wrap(' ', ' ', $oi); - exit(1); - } else { - print "not ok $tn\n"; - } - $tn++; + ok( $back eq $out ); } @@ -140,34 +117,12 @@ while(@st) { my $back = wrap(' ', ' ', @in); - if ($back eq $out) { - print "ok $tn\n"; - } elsif ($rerun) { - my $oi = $in; - foreach ($in, $back, $out) { - s/\t/^I\t/gs; - s/\n/\$\n/gs; - } - print "------------ input2 ------------\n"; - print $in; - print "\n------------ output2 -----------\n"; - print $back; - print "\n------------ expected2 ---------\n"; - print $out; - print "\n-------------------------------\n"; - $Text::Wrap::debug = 1; - wrap(' ', ' ', $oi); - exit(1); - } else { - print "not ok $tn\n"; - } - $tn++; + ok( $back eq $out ); } $Text::Wrap::huge = 'overflow'; my $tw = 'This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_program_does_not_crash_and_burn'; my $w = wrap('zzz','yyy',$tw); -print (($w eq "zzz$tw") ? "ok $tn\n" : "not ok $tn"); -$tn++; +ok( $w eq "zzz$tw" ); diff --git a/cpan/Text-Tabs/t/sep2.t b/cpan/Text-Tabs/t/sep2.t index 417ef01dc7..6ce0e16bc8 100644 --- a/cpan/Text-Tabs/t/sep2.t +++ b/cpan/Text-Tabs/t/sep2.t @@ -1,6 +1,9 @@ -no strict; no warnings; +use strict; use warnings; -@tests = (split(/\nEND\n/s, <<DONE)); +BEGIN { require './t/lib/ok.pl' } +use Text::Wrap; + +my @tests = (split(/\nEND\n/s, <<DONE)); TEST1 This is @@ -98,16 +101,11 @@ END DONE -$| = 1; - print "1..", 1 +@tests, "\n"; -use Text::Wrap; $Text::Wrap::separator2 = '='; -$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1; - -$tn = 1; +my @st; @st = @tests; while (@st) { @@ -118,28 +116,7 @@ while (@st) { my $back = wrap(' ', ' ', $in); - if ($back eq $out) { - print "ok $tn\n"; - } elsif ($rerun) { - my $oi = $in; - foreach ($in, $back, $out) { - s/\t/^I\t/gs; - s/\n/\$\n/gs; - } - print "------------ input ------------\n"; - print $in; - print "\n------------ output -----------\n"; - print $back; - print "\n------------ expected ---------\n"; - print $out; - print "\n-------------------------------\n"; - $Text::Wrap::debug = 1; - wrap(' ', ' ', $oi); - exit(1); - } else { - print "not ok $tn\n"; - } - $tn++; + ok( $back eq $out ); } @@ -155,34 +132,12 @@ while(@st) { my $back = wrap(' ', ' ', @in); - if ($back eq $out) { - print "ok $tn\n"; - } elsif ($rerun) { - my $oi = $in; - foreach ($in, $back, $out) { - s/\t/^I\t/gs; - s/\n/\$\n/gs; - } - print "------------ input2 ------------\n"; - print $in; - print "\n------------ output2 -----------\n"; - print $back; - print "\n------------ expected2 ---------\n"; - print $out; - print "\n-------------------------------\n"; - $Text::Wrap::debug = 1; - wrap(' ', ' ', $oi); - exit(1); - } else { - print "not ok $tn\n"; - } - $tn++; + ok( $back eq $out ); } $Text::Wrap::huge = 'overflow'; my $tw = 'This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_program_does_not_crash_and_burn'; my $w = wrap('zzz','yyy',$tw); -print (($w eq "zzz$tw") ? "ok $tn\n" : "not ok $tn"); -$tn++; +ok( $w eq "zzz$tw" ); diff --git a/cpan/Text-Tabs/t/tabs.t b/cpan/Text-Tabs/t/tabs.t index e6f3f3f383..f98836d495 100644 --- a/cpan/Text-Tabs/t/tabs.t +++ b/cpan/Text-Tabs/t/tabs.t @@ -1,6 +1,9 @@ -no strict; use warnings; +use strict; use warnings; -@tests = (split(/\nEND\n/s, <<DONE)); +BEGIN { require './t/lib/ok.pl' } +use Text::Tabs; + +my @tests = (split(/\nEND\n/s, <<DONE)); TEST 1 u x END @@ -84,52 +87,19 @@ foobar IN A 140.174.82.12 END DONE -$| = 1; my $numtests = scalar(@tests) / 2; print "1..$numtests\n"; -use Text::Tabs; - -$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1; - -$tn = 1; while (@tests) { my $in = shift(@tests); my $out = shift(@tests); $in =~ s/^TEST\s*(\d+)?\s*(\S+)?\n//; - if ($2 eq 'e') { - $f = \&expand; - $fn = 'expand'; - } else { - $f = \&unexpand; - $fn = 'unexpand'; - } + my $f = $2 eq 'e' ? \&expand : \&unexpand; my $back = &$f($in); - if ($back eq $out) { - print "ok $tn\n"; - } elsif ($rerun) { - my $oi = $in; - foreach ($in, $back, $out) { - s/\t/^I\t/gs; - s/\n/\$\n/gs; - } - print "------------ input ------------\n"; - print $in; - print "\$\n------------ $fn -----------\n"; - print $back; - print "\$\n------------ expected ---------\n"; - print $out; - print "\$\n-------------------------------\n"; - $Text::Tabs::debug = 1; - my $back = &$f($in); - exit(1); - } else { - print "not ok $tn\n"; - } - $tn++; + ok( $back eq $out ); } diff --git a/cpan/Text-Tabs/t/wrap.t b/cpan/Text-Tabs/t/wrap.t index e3b890dd38..a76b05a897 100644 --- a/cpan/Text-Tabs/t/wrap.t +++ b/cpan/Text-Tabs/t/wrap.t @@ -1,6 +1,9 @@ -no strict; no warnings; +use strict; use warnings; -@tests = (split(/\nEND\n/s, <<'DONE')); +BEGIN { require './t/lib/ok.pl' } +use Text::Wrap; + +my @tests = (split(/\nEND\n/s, <<'DONE')); TEST1 This is @@ -126,15 +129,9 @@ END DONE -$| = 1; - print "1..", 2 +@tests, "\n"; -use Text::Wrap; - -$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1; - -$tn = 1; +my @st; @st = @tests; while (@st) { @@ -147,28 +144,7 @@ while (@st) { my $back = wrap(' ', ' ', $in); - if ($back eq $out) { - print "ok $tn\n"; - } elsif ($rerun) { - my $oi = $in; - foreach ($in, $back, $out) { - s/\t/^I\t/gs; - s/\n/\$\n/gs; - } - print "------------ input ------------\n"; - print $in; - print "\n------------ output -----------\n"; - print $back; - print "\n------------ expected ---------\n"; - print $out; - print "\n-------------------------------\n"; - $Text::Wrap::debug = 1; - wrap(' ', ' ', $oi); - exit(1); - } else { - print "not ok $tn\n"; - } - $tn++; + ok( $back eq $out ); } @@ -186,40 +162,17 @@ while(@st) { my $back = wrap(' ', ' ', @in); - if ($back eq $out) { - print "ok $tn\n"; - } elsif ($rerun) { - my $oi = $in; - foreach ($in, $back, $out) { - s/\t/^I\t/gs; - s/\n/\$\n/gs; - } - print "------------ input2 ------------\n"; - print $in; - print "\n------------ output2 -----------\n"; - print $back; - print "\n------------ expected2 ---------\n"; - print $out; - print "\n-------------------------------\n"; - $Text::Wrap::debug = 1; - wrap(' ', ' ', $oi); - exit(1); - } else { - print "not ok $tn\n"; - } - $tn++; + ok( $back eq $out ); } $Text::Wrap::huge = 'overflow'; my $tw = 'This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_program_does_not_crash_and_burn'; my $w = wrap('zzz','yyy',$tw); -print (($w eq "zzz$tw") ? "ok $tn\n" : "not ok $tn"); -$tn++; +ok( $w eq "zzz$tw" ); { local $Text::Wrap::columns = 10; local $Text::Wrap::huge = "wrap"; - print ((wrap("verylongindent", "", "foo") eq "verylongindent\nfoo") ? "ok $tn\n" : "not ok $tn"); - $tn++; + ok( wrap( 'verylongindent', '', 'foo' ) eq "verylongindent\nfoo" ); } diff --git a/cpan/Text-Tabs/t/wrap_separator2.t b/cpan/Text-Tabs/t/wrap_separator2.t index c9a7654a09..4678f4e208 100644 --- a/cpan/Text-Tabs/t/wrap_separator2.t +++ b/cpan/Text-Tabs/t/wrap_separator2.t @@ -1,13 +1,15 @@ use strict; use warnings; #Author: Dan Dascalescu -use Test::More tests => 1; +BEGIN { require './t/lib/ok.pl' } use Text::Wrap; +print "1..1\n"; + local $Text::Wrap::columns = 15; local $Text::Wrap::separator2 = '[N]'; -is(wrap('','','some long text here that should be wrapped on at least three lines'), +ok(wrap('','','some long text here that should be wrapped on at least three lines') eq "some long text[N]here that[N]should be[N]wrapped on at[N]least three[N]lines", 'If you just to preserve existing newlines but add new breaks with something else, set $Text::Wrap::separator2 instead.'); |