cpan/Text-Tabs/t/Jochen.t See if Text::Tabs is working
cpan/Text-Tabs/t/sep2.t See if Text::Tabs is working
cpan/Text-Tabs/t/sep.t See if Text::Tabs is working
+cpan/Text-Tabs/t/Tabs-ElCid.t See if Text::Tabs works
cpan/Text-Tabs/t/tabs.t See if Text::Tabs works
+cpan/Text-Tabs/t/Wrap-JLB.t See if Text::Wrap::wrap works
cpan/Text-Tabs/t/wrap_separator2.t See if Text::Wrap::wrap works
cpan/Text-Tabs/t/wrap.t See if Text::Wrap::wrap works
cpan/Tie-RefHash/lib/Tie/RefHash.pm Base class for tied hashes with references as keys
'Text-Tabs+Wrap' => {
'MAINTAINER' => 'muir',
- 'DISTRIBUTION' => 'MUIR/modules/Text-Tabs+Wrap-2009.0305.tar.gz',
+ 'DISTRIBUTION' => 'MUIR/modules/Text-Tabs+Wrap-2012.0818.tar.gz',
'FILES' => q[cpan/Text-Tabs],
- 'EXCLUDED' => ['t/dnsparks.t'], # see af6492bf9e
- 'UPSTREAM' => 'cpan',
- 'CUSTOMIZED' => [
- qw( t/fill.t
- t/tabs.t
- ),
+ 'EXCLUDED' => [
+ qr/^lib\.old/,
+ 't/dnsparks.t', # see af6492bf9e
],
+ 'MAP' => {
+ '' => 'cpan/Text-Tabs/',
+ 'lib.modern/Text/Tabs.pm' => 'cpan/Text-Tabs/lib/Tabs.pm',
+ 'lib.modern/Text/Wrap.pm' => 'cpan/Text-Tabs/lib/Wrap.pm',
+ },
+ 'UPSTREAM' => 'cpan',
},
'Thread::Queue' => {
+= 2012/08/18
+
+Packaging fix.
+
+Minor documentation fixes.
+
+= 2012/08/15
+
+Minor fixes to test suites.
+
+Added back versions to support old versions of perl.
+
+= 2009/04/17
+
+Added support for Unicode combining characters to both
+Text::Tabs and Text::Wrap, plus a new test suite for each
+of these new functionalities. --tchrist
+
= 2009/03/05
Test improvements from Dave Mitchel sent back in 2005...
@ISA = (Exporter);
@EXPORT = qw(expand unexpand $tabstop);
-use vars qw($VERSION $tabstop $debug);
-$VERSION = 2009.0305;
+use vars qw($VERSION $SUBVERSION $tabstop $debug);
+$VERSION = 2012.0818;
+$SUBVERSION = 'modern';
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]) ) ) }
+
sub expand {
my @l;
my $pad;
for (split(/^/m, $_, -1)) {
my $offs = 0;
s{\t}{
- $pad = $tabstop - (pos() + $offs) % $tabstop;
+ # 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;
- }eg;
+ }peg;
$s .= $_;
}
push(@l, $s);
my $line;
my @lines;
my $lastbit;
- my $ts_as_space = " "x$tabstop;
+ my $ts_as_space = " " x $tabstop;
for $x (@l) {
@lines = split("\n", $x, -1);
for $line (@lines) {
$line = expand($line);
- @e = split(/(.{$tabstop})/,$line,-1);
+ @e = split(/(${CHUNK}{$tabstop})/,$line,-1);
$lastbit = pop(@e);
$lastbit = ''
unless defined $lastbit;
=head1 NAME
-Text::Tabs -- expand and unexpand tabs per the unix expand(1) and unexpand(1)
+Text::Tabs - expand and unexpand tabs like unix expand(1) and unexpand(1)
=head1 SYNOPSIS
=head1 DESCRIPTION
-Text::Tabs does about what the unix utilities expand(1) and unexpand(1)
-do. Given a line with tabs in it, expand will replace the tabs with
+Text::Tabs does most of what the unix utilities expand(1) and unexpand(1)
+do. Given a line with tabs in it, C<expand> replaces those tabs with
the appropriate number of spaces. Given a line with or without tabs in
-it, unexpand will add tabs when it can save bytes by doing so (just
-like C<unexpand -a>). Invisible compression with plain ASCII!
+it, C<unexpand> adds tabs when it can save bytes by doing so,
+like the C<unexpand -a> command.
+
+Unlike the old unix utilities, this module correctly accounts for
+any Unicode combining characters (such as diacriticals) that may occur
+in each line for both expansion and unexpansion. These are overstrike
+characters that do not increment the logical position. Make sure
+you have the appropriate Unicode settings enabled.
+
+=head1 EXPORTS
+
+The following are exported:
+
+=over 4
+
+=item expand
+
+=item unexpand
+
+=item $tabstop
+
+The C<$tabstop> variable controls how many column positions apart each
+tabstop is. The default is 8.
+
+Please note that C<local($tabstop)> doesn't do the right thing and if you want
+to use C<local> to override C<$tabstop>, you need to use
+C<local($Text::Tabs::tabstop)>.
+
+=back
=head1 EXAMPLE
print unexpand $_;
}
-Instead of the C<expand> comand, use:
+Instead of the shell's C<expand> comand, use:
perl -MText::Tabs -n -e 'print expand $_'
-Instead of the C<unexpand -a> command, use:
+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
+count backwards for backspaces (C<"\t">), omit other non-printing control characters (C</\pC/>),
+or otherwise deal with any other zero-, half-, and full-width characters.
+
=head1 LICENSE
Copyright (C) 1996-2002,2005,2006 David Muir Sharnoff.
Copyright (C) 2005 Aristotle Pagaltzis
+Copyright (C) 2012 Google, Inc.
This module may be modified, used, copied, and redistributed at your own risk.
Publicly redistributed modified versions must use a different name.
@EXPORT = qw(wrap fill);
@EXPORT_OK = qw($columns $break $huge);
-$VERSION = 2009.0305;
+$VERSION = 2012.0818;
+$SUBVERSION = 'modern';
-use vars qw($VERSION $columns $debug $break $huge $unexpand $tabstop
- $separator $separator2);
+use 5.010_000;
+
+use vars qw($VERSION $SUBVERSION $columns $debug $break $huge $unexpand $tabstop $separator $separator2);
use strict;
BEGIN {
$columns = 76; # <= screen width
$debug = 0;
- $break = '\s';
+ $break = '(?=\s)\X';
$huge = 'wrap'; # alternatively: 'die' or 'overflow'
$unexpand = 1;
$tabstop = 8;
$separator2 = undef;
}
+my $CHUNK = qr/\X/;
+
+sub _xlen(_) { scalar(() = $_[0] =~ /$CHUNK/g) }
+
+sub _xpos(_) { _xlen( substr( $_[0], 0, pos($_[0]) ) ) }
+
use Text::Tabs qw(expand unexpand);
sub wrap
my $tail = pop(@t);
my $t = expand(join("", (map { /\s+\z/ ? ( $_ ) : ($_, ' ') } @t), $tail));
my $lead = $ip;
- my $nll = $columns - length(expand($xp)) - 1;
+ my $nll = $columns - _xlen(expand($xp)) - 1;
if ($nll <= 0 && $xp ne '') {
- my $nc = length(expand($xp)) + 2;
+ my $nc = _xlen(expand($xp)) + 2;
warnings::warnif "Increasing \$Text::Wrap::columns from $columns to $nc to accommodate length of subsequent tab";
$columns = $nc;
$nll = 1;
}
- my $ll = $columns - length(expand($ip)) - 1;
+ my $ll = $columns - _xlen(expand($ip)) - 1;
$ll = 0 if $ll < 0;
my $nl = "";
my $remainder = "";
pos($t) = 0;
while ($t !~ /\G(?:$break)*\Z/gc) {
- if ($t =~ /\G([^\n]{0,$ll})($break|\n+|\z)/xmgc) {
+ if ($t =~ /\G((?:(?=[^\n])\X){0,$ll})($break|\n+|\z)/xmgc) {
$r .= $unexpand
? unexpand($nl . $lead . $1)
: $nl . $lead . $1;
$remainder = $2;
- } elsif ($huge eq 'wrap' && $t =~ /\G([^\n]{$ll})/gc) {
+ } elsif ($huge eq 'wrap' && $t =~ /\G((?:(?!=[^\n])\X){$ll})/gc) {
$r .= $unexpand
? unexpand($nl . $lead . $1)
: $nl . $lead . $1;
$remainder = defined($separator2) ? $separator2 : $separator;
- } elsif ($huge eq 'overflow' && $t =~ /\G([^\n]*?)($break|\n+|\z)/xmgc) {
+ } elsif ($huge eq 'overflow' && $t =~ /\G((?:(?=[^\n])\X)*?)($break|\n+|\z)/xmgc) {
$r .= $unexpand
? unexpand($nl . $lead . $1)
: $nl . $lead . $1;
print "Finish up with '$lead'\n" if $debug;
- $r .= $lead . substr($t, pos($t), length($t)-pos($t))
+ 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;;
$huge = 'overflow';
B<Example 3>
-
+
use Text::Wrap;
$Text::Wrap::columns = 72;
C<$initial_tab> and C<$subsequent_tab> are the literal strings that will
be used: it is unlikely you would want to pass in a number.
-Text::Wrap::fill() is a simple multi-paragraph formatter. It formats
+C<Text::Wrap::fill()> is a simple multi-paragraph formatter. It formats
each paragraph separately and then joins them together when it's done. It
will destroy any whitespace in the original text. It breaks text into
-paragraphs by looking for whitespace after a newline. In other respects
+paragraphs by looking for whitespace after a newline. In other respects,
it acts like wrap().
+C<wrap()> compresses trailing whitespace into one newline, and C<fill()>
+deletes all trailing whitespace.
+
Both C<wrap()> and C<fill()> return a single string.
+Unlike the old Unix fmt(1) utility, this module correctly accounts for
+any Unicode combining characters (such as diacriticals) that may occur
+in each line for both expansion and unexpansion. These are overstrike
+characters that do not increment the logical position. Make sure
+you have the appropriate Unicode settings enabled.
+
=head1 OVERRIDES
C<Text::Wrap::wrap()> has a number of variables that control its behavior.
"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 wrapping multi-byte characters: L<Text::WrapI18N>.
-For more detailed controls: L<Text::Format>.
+For correct handling of East Asian half- and full-width characters,
+see L<Text::WrapI18N>. For more detailed controls: L<Text::Format>.
+
+=head1 AUTHOR
+
+David Muir Sharnoff <cpan@dave.sharnoff.org> with help from Tim Pierce and
+many many others.
=head1 LICENSE
-David Muir Sharnoff <muir@idiom.org> with help from Tim Pierce and
-many many others. Copyright (C) 1996-2009 David Muir Sharnoff.
-This module may be modified, used, copied, and redistributed at
-your own risk. Publicly redistributed versions that are modified
-must use a different name.
+Copyright (C) 1996-2009 David Muir Sharnoff.
+Copyright (C) 2012 Google, Inc.
+This module may be modified, used, copied, and redistributed at your own risk.
+Publicly redistributed modified versions must use a different name.
$huge='overflow';
$Text::Wrap::columns=9;
-$break="(?<=[,.])";
+$break=".(?<=[,.])";
eval {
$a=$a=wrap('','',
"mmmm,n,ooo,ppp.qqqq.rrrrr,sssssssssssss,ttttttttt,uu,vvv wwwwwwwww####\n");
$huge='overflow';
$Text::Wrap::columns=9;
-$break="(?<=[,.])";
+$break=".(?<=[,.])";
eval {
$a=$a=wrap('','',
"mmmm,n,ooo,ppp.qqqq.rrrrr.adsljasdf\nlasjdflajsdflajsdfljasdfl\nlasjdflasjdflasf,sssssssssssss,ttttttttt,uu,vvv wwwwwwwww####\n");
--- /dev/null
+#!perl
+
+BEGIN {
+ if ($] <= 5.010) {
+ print "1..0 # skip this test requires perl 5.010 or greater\n";
+ exit 0;
+ }
+}
+
+use strict;
+use warnings "FATAL" => "all";
+use Text::Tabs;
+
+require bytes;
+
+our $Errors = 0;
+
+our @DATA = (
+ [ # DATALINE #0
+ sub { die "there is no line 0" }
+ ],
+ { # DATALINE #1
+ OLD => { BYTES => 71, CHARS => 59, CHUNKS => 47, WORDS => 7, TABS => 3 },
+ NEW => { BYTES => 92, CHARS => 80, CHUNKS => 68, WORDS => 7, TABS => 0 },
+ },
+ { # DATALINE #2
+ OLD => { BYTES => 45, CHARS => 43, CHUNKS => 41, WORDS => 6, TABS => 3 },
+ NEW => { BYTES => 65, CHARS => 63, CHUNKS => 61, WORDS => 6, TABS => 0 },
+ },
+ { # DATALINE #3
+ OLD => { BYTES => 47, CHARS => 45, CHUNKS => 43, WORDS => 7, TABS => 3 },
+ NEW => { BYTES => 64, CHARS => 62, CHUNKS => 60, WORDS => 7, TABS => 0 },
+ },
+ { # DATALINE #4
+ OLD => { BYTES => 49, CHARS => 47, CHUNKS => 45, WORDS => 7, TABS => 3 },
+ NEW => { BYTES => 69, CHARS => 67, CHUNKS => 65, WORDS => 7, TABS => 0 },
+ },
+ { # DATALINE #5
+ OLD => { BYTES => 83, CHARS => 62, CHUNKS => 41, WORDS => 7, TABS => 4 },
+ NEW => { BYTES => 105, CHARS => 84, CHUNKS => 63, WORDS => 7, TABS => 0 },
+ },
+ { # DATALINE #6
+ OLD => { BYTES => 55, CHARS => 53, CHUNKS => 51, WORDS => 8, TABS => 3 },
+ NEW => { BYTES => 76, CHARS => 74, CHUNKS => 72, WORDS => 8, TABS => 0 },
+ },
+ { # DATALINE #7
+ OLD => { BYTES => 42, CHARS => 40, CHUNKS => 38, WORDS => 7, TABS => 4 },
+ NEW => { BYTES => 65, CHARS => 63, CHUNKS => 61, WORDS => 7, TABS => 0 },
+ },
+ { # DATALINE #8
+ OLD => { BYTES => 80, CHARS => 65, CHUNKS => 52, WORDS => 9, TABS => 1 },
+ NEW => { BYTES => 87, CHARS => 72, CHUNKS => 59, WORDS => 9, TABS => 0 },
+ },
+ { # DATALINE #9
+ OLD => { BYTES => 43, CHARS => 41, CHUNKS => 41, WORDS => 7, TABS => 3 },
+ NEW => { BYTES => 63, CHARS => 61, CHUNKS => 61, WORDS => 7, TABS => 0 },
+ },
+);
+
+$| = 1;
+my $numtests = @DATA;
+print "1..$numtests\n";
+
+$Errors += table_ok();
+check_data();
+
+if ($Errors) {
+ die "Error count: $Errors";
+} else {
+ exit(0);
+}
+
+
+# first some sanity checks
+sub table_ok {
+ my $bad = 0;
+ for my $i ( 1 .. $#DATA ) {
+
+ if ( $DATA[$i]{NEW}{TABS} ) {
+ warn "new data should have no tabs in it at table line $i";
+ $bad++;
+ }
+
+ if ( $DATA[$i]{NEW}{WORDS} != $DATA[$i]{OLD}{WORDS} ) {
+ warn "word count shouldn't change upon tab expansion at table line $i";
+ $bad++;
+ }
+ }
+ print $bad ? "not " : "", "ok 1\n";
+ return $bad;
+}
+
+sub check($$$$) {
+ die "expected 4 arguments" unless @_ == 4;
+ my ($found, $index, $version, $item) = @_;
+ my $expected = $DATA[$index]{$version}{$item};
+ return 1 if $found == $expected;
+ warn sprintf("%s line %d expected %d %s, found %d instead",
+ ucfirst(lc($version)),
+ $index, $expected,
+ lc($item),
+ $found);
+ return 0;
+}
+
+sub check_data {
+
+ binmode(DATA, ":utf8") || die "can't binmode DATA to utf8: $!";
+ while ( my $_ = <DATA> ) {
+
+ my $bad = 0;
+
+ if ($. > $#DATA) {
+ die "too many lines of data";
+ }
+
+ $DATA[$.]{OLD}{DATA} = $_;
+
+ my($char_count, $byte_count, $chunk_count, $word_count, $tab_count);
+
+ $byte_count = bytes::length($_);
+ $char_count = length();
+ $chunk_count = () = /\X/g;
+ $word_count = () = /(?:(?=\pL)\X)+/g;
+ $tab_count = y/\t//;
+
+ $bad++ unless check($byte_count, $., "OLD", "BYTES");
+ $bad++ unless check($char_count, $., "OLD", "CHARS");
+ $bad++ unless check($chunk_count, $., "OLD", "CHUNKS");
+ $bad++ unless check($word_count, $., "OLD", "WORDS");
+ $bad++ unless check($tab_count, $., "OLD", "TABS");
+
+ $_ = expand($_);
+
+ $DATA[$.]{NEW}{DATA} = $_;
+
+ $byte_count = bytes::length($_);
+ $char_count = length();
+ $chunk_count = () = /\X/g;
+ $word_count = () = /(?:(?=\pL)\X)+/g;
+ $tab_count = y/\t//;
+
+ $bad++ unless check($byte_count, $., "NEW", "BYTES");
+ $bad++ unless check($char_count, $., "NEW", "CHARS");
+ $bad++ unless check($chunk_count, $., "NEW", "CHUNKS");
+ $bad++ unless check($word_count, $., "NEW", "WORDS");
+ $bad++ unless check($tab_count, $., "NEW", "TABS");
+
+ $_ = unexpand($_);
+
+ if ($_ ne $DATA[$.]{OLD}{DATA}) {
+ warn "expand/unexpand round-trip equivalency failed at line $.";
+ warn sprintf(" Expected:\n%s\n%v02x\n But got:\n%s\n%v02x\n",
+ ( $DATA[$.]{OLD}{DATA} ) x 2, ($_) x 2 );
+ $bad++;
+ }
+
+ my $num = $. + 1;
+ print $bad ? "not " : "", "ok $num\n";
+ $Errors += $bad;
+
+ }
+
+}
+
+
+__DATA__
+ De los sos o̲j̲o̲s̲ tan fuertemientre l̲l̲o̲r̲a̲n̲d̲o̲,
+ tornava la cabeça i estávalos catando.
+ Vio puertas abiertas e uços sin cañados,
+ alcándaras vázias sin pielles e sin mantos
+ e s̲i̲n̲ f̲a̲l̲c̲o̲n̲e̲s̲ e s̲i̲n̲ a̲d̲t̲o̲r̲e̲s̲ mudados.
+ Sospiró mio Çid, ca mucho avie grandes cuidados.
+ Fabló mio Çid bien e tan mesurado:
+ “grado a tí, s̳e̳ñ̳o̳r̳ p̳a̳d̳r̳e̳, que estás en alto!
+ Esto me an buelto mis enemigos malos.”
--- /dev/null
+#!perl
+
+BEGIN {
+ if ($] <= 5.010) {
+ print "1..0 # skip this test requires perl 5.010 or greater\n";
+ exit 0;
+ }
+}
+
+use strict;
+use warnings "FATAL" => "all";
+use Text::Wrap;
+
+$Text::Wrap::columns = 72;
+
+require bytes;
+
+our $Errors = 0;
+
+$/ = q();
+binmode(DATA, ":utf8") || die "can't binmode DATA to utf8: $!";
+
+our @DATA = (
+ [ # paragraph 0
+ sub { die "there is no paragraph 0" }
+ ],
+ { # paragraph 1
+ OLD => { BYTES => 44, CHARS => 44, CHUNKS => 44, WORDS => 7, TABS => 3, LINES => 4 },
+ NEW => { BYTES => 44, CHARS => 44, CHUNKS => 44, WORDS => 7, TABS => 3, LINES => 4 },
+ },
+ { # paragraph 2
+ OLD => { BYTES => 1766, CHARS => 1635, CHUNKS => 1507, WORDS => 275, TABS => 0, LINES => 2 },
+ NEW => { BYTES => 1766, CHARS => 1635, CHUNKS => 1507, WORDS => 275, TABS => 0, LINES => 24 },
+ },
+ { # paragraph 3
+ OLD => { BYTES => 157, CHARS => 148, CHUNKS => 139, WORDS => 27, TABS => 0, LINES => 2 },
+ NEW => { BYTES => 157, CHARS => 148, CHUNKS => 139, WORDS => 27, TABS => 0, LINES => 3 },
+ },
+ { # paragraph 4
+ OLD => { BYTES => 30, CHARS => 25, CHUNKS => 24, WORDS => 3, TABS => 4, LINES => 1 },
+ NEW => { BYTES => 30, CHARS => 25, CHUNKS => 24, WORDS => 3, TABS => 4, LINES => 1 },
+ },
+);
+
+$| = 1;
+my $numtests = @DATA;
+print "1..$numtests\n";
+
+$Errors += table_ok();
+check_data();
+
+if ($Errors) {
+ die "Error count: $Errors";
+} else {
+ exit(0);
+}
+
+
+# first some sanity checks
+sub table_ok {
+ my $bad = 0;
+ for my $i ( 1 .. $#DATA ) {
+ for my $item (qw[ bytes chars chunks words tabs ]) {
+ if ( $DATA[$i]{NEW}{uc $item} != $DATA[$i]{OLD}{uc $item} ) {
+ warn "\u$item count shouldn't change upon wrapping at table paragraph $i";
+ $bad++;
+ }
+ }
+ }
+ print $bad ? "not " : "", "ok 1\n";
+ return $bad;
+}
+
+sub check($$$$) {
+ die "expected 4 arguments" unless @_ == 4;
+ my ($found, $index, $version, $item) = @_;
+ my $expected = $DATA[$index]{$version}{$item};
+ return 1 if $found == $expected;
+ warn sprintf("%s paragraph %d expected %d %s, found %d instead",
+ ucfirst(lc($version)),
+ $index, $expected,
+ lc($item),
+ $found);
+ return 0;
+}
+
+sub check_data {
+
+ binmode(DATA, ":utf8") || die "can't binmode DATA to utf8: $!";
+ while ( my $_ = <DATA> ) {
+
+ my $bad = 0;
+
+ if ($. > $#DATA) {
+ die "too many paragraphs of data";
+ }
+
+ $DATA[$.]{OLD}{DATA} = $_;
+
+ my($char_count, $byte_count, $chunk_count, $word_count, $tab_count, $line_count);
+
+ $byte_count = bytes::length($_);
+ $char_count = length();
+ $chunk_count = () = /\X/g;
+ $word_count = () = /(?:(?=\pL)\X)+/g;
+ $tab_count = y/\t//;
+ $line_count = y/\n//;
+
+ $bad++ unless check($byte_count, $., "OLD", "BYTES");
+ $bad++ unless check($char_count, $., "OLD", "CHARS");
+ $bad++ unless check($chunk_count, $., "OLD", "CHUNKS");
+ $bad++ unless check($word_count, $., "OLD", "WORDS");
+ $bad++ unless check($tab_count, $., "OLD", "TABS");
+ $bad++ unless check($line_count, $., "OLD", "LINES");
+
+ my $nl = "\n" x chomp;
+
+ $_ = wrap("", "", $_) . $nl;
+
+ $byte_count = bytes::length($_);
+ $char_count = length();
+ $chunk_count = () = /\X/g;
+ $word_count = () = /(?:(?=\pL)\X)+/g;
+ $tab_count = y/\t//;
+ $line_count = y/\n//;
+
+ $bad++ unless check($byte_count, $., "NEW", "BYTES");
+ $bad++ unless check($char_count, $., "NEW", "CHARS");
+ $bad++ unless check($chunk_count, $., "NEW", "CHUNKS");
+ $bad++ unless check($word_count, $., "NEW", "WORDS");
+ $bad++ unless check($tab_count, $., "NEW", "TABS");
+ $bad++ unless check($line_count, $., "NEW", "LINES");
+
+ my $num = $. + 1;
+ print $bad ? "not " : "", "ok $num\n";
+ $Errors += $bad;
+
+ }
+
+}
+
+__DATA__
+ Los dos reyes
+ y
+ Los dos laberintos
+
+Cuentan los hombres dignos de fe (pero A̳l̳á̳ sabe más) que en los primeros días hubo un rey de l̲a̲s̲ i̲s̲l̲a̲s̲ d̲e̲ B̲a̲b̲i̲l̲o̲n̲i̲a̲ que congregó a sus arquitectos y magos y les mandó construir un laberinto tan perplejo y sutil que los varones más prudentes no se aventuraban a entrar, y los que entraban se perdían. Esa obra era un escándalo, porque la confusión y la maravilla son operaciones propias de D̳i̳o̳s̳ y no de los hombres. Con el andar del tiempo vino a su corte un rey de los árabes, y el rey de B̲a̲b̲i̲l̲o̲n̲i̲a̲ (para hacer burla de la simplicidad de su huésped) lo hizo penetrar en el laberinto, donde vagó afrentado y confundido hasta la declinación de la tarde. Entonces imploró socorro divino y dio con la puerta. Sus labios no profirieron queja ninguna, pero le dijo al rey de B̲a̲b̲i̲l̲o̲n̲i̲a̲ que él en A̲r̲a̲b̲i̲a̲ tenía otro laberinto y que, si D̳i̳o̳s̳ era servido, se lo daría a conocer algún día. Luego regresó a A̲r̲a̲b̲i̲a̲, juntó sus capitanes y sus alcaides y estragó l̲o̲s̲ r̲e̲i̲n̲o̲s̲ d̲e̲ B̲a̲b̲i̲l̲o̲n̲i̲a̲ con tan venturosa fortuna que derribó sus castillos, rompió sus gentes e hizo cautivo al mismo rey. Lo amarró encima de un camello veloz y lo llevó al desierto. Cabalgaron tres días, y le dijo: «¡Oh, rey del tiempo y substancia y cifra del siglo!, en B̲a̲b̲i̲l̲o̲n̲i̲a̲ me quisiste perder en un laberinto de bronce con muchas escaleras, puertas y muros; ahora e̳l̳ P̳o̳d̳e̳r̳o̳s̳o̳ ha tenido a bien que te muestre el mío, donde no hay escaleras que subir, ni puertas que forzar, ni fatigosas galerías que recorrer, ni muros que te veden el paso.»
+
+Luego le desató las ligaduras y lo abandonó en mitad del desierto, donde murió de hambre y de sed. La gloria sea con A̳q̳u̳é̳l̳ que no muere.
+
+ ——Jorge Luís Borges
=item *
+L<Text-Tabs+Wrap> has been upgraded from version 2009.0305 to 2012.0818.
+Support for Unicode combining characters has been added to both Text::Tabs and
+Text::Wrap,
+
+=item *
+
L<Time::Local> has been upgraded from version 1.2000 to 1.2300. Seconds values
greater than 59 but less than 60 no longer cause C<timegm()> and C<timelocal()>
to croak.
projects / platform / upstream / perl.git / commitdiff