1#!perl
2
3BEGIN {
4	if ($] <= 5.010) {
5		print "1..0 # skip this test requires perl 5.010 or greater ($])\n";
6		exit 0;
7	}
8}
9
10use strict;
11use warnings "FATAL" => "all";
12use Text::Tabs;
13
14require bytes;
15
16our $Errors = 0;
17
18our @DATA = (
19    [ # DATALINE #0
20	sub { die "there is no line 0" }
21    ],
22    { # DATALINE #1
23	OLD => { BYTES =>  71, CHARS => 59, CHUNKS => 47, WORDS => 7, TABS => 3 },
24	NEW => { BYTES =>  92, CHARS => 80, CHUNKS => 68, WORDS => 7, TABS => 0 },
25    },
26    { # DATALINE #2
27	OLD => { BYTES =>  45, CHARS => 43, CHUNKS => 41, WORDS => 6, TABS => 3 },
28	NEW => { BYTES =>  65, CHARS => 63, CHUNKS => 61, WORDS => 6, TABS => 0 },
29    },
30    { # DATALINE #3
31	OLD => { BYTES =>  47, CHARS => 45, CHUNKS => 43, WORDS => 7, TABS => 3 },
32	NEW => { BYTES =>  64, CHARS => 62, CHUNKS => 60, WORDS => 7, TABS => 0 },
33    },
34    { # DATALINE #4
35	OLD => { BYTES =>  49, CHARS => 47, CHUNKS => 45, WORDS => 7, TABS => 3 },
36	NEW => { BYTES =>  69, CHARS => 67, CHUNKS => 65, WORDS => 7, TABS => 0 },
37    },
38    { # DATALINE #5
39	OLD => { BYTES =>  83, CHARS => 62, CHUNKS => 41, WORDS => 7, TABS => 4 },
40	NEW => { BYTES => 105, CHARS => 84, CHUNKS => 63, WORDS => 7, TABS => 0 },
41    },
42    { # DATALINE #6
43	OLD => { BYTES =>  55, CHARS => 53, CHUNKS => 51, WORDS => 8, TABS => 3 },
44	NEW => { BYTES =>  76, CHARS => 74, CHUNKS => 72, WORDS => 8, TABS => 0 },
45    },
46    { # DATALINE #7
47	OLD => { BYTES =>  42, CHARS => 40, CHUNKS => 38, WORDS => 7, TABS => 4 },
48	NEW => { BYTES =>  65, CHARS => 63, CHUNKS => 61, WORDS => 7, TABS => 0 },
49    },
50    { # DATALINE #8
51	OLD => { BYTES =>  80, CHARS => 65, CHUNKS => 52, WORDS => 9, TABS => 1 },
52	NEW => { BYTES =>  87, CHARS => 72, CHUNKS => 59, WORDS => 9, TABS => 0 },
53    },
54    { # DATALINE #9
55	OLD => { BYTES =>  43, CHARS => 41, CHUNKS => 41, WORDS => 7, TABS => 3 },
56	NEW => { BYTES =>  63, CHARS => 61, CHUNKS => 61, WORDS => 7, TABS => 0 },
57    },
58);
59
60$| = 1;
61my $numtests = @DATA;
62print "1..$numtests\n";
63
64$Errors += table_ok();
65check_data();
66
67if ($Errors) {
68    die "Error count: $Errors";
69} else {
70    exit(0);
71}
72
73
74# first some sanity checks
75sub table_ok {
76    my $bad = 0;
77    for my $i ( 1 .. $#DATA ) {
78
79	if ( $DATA[$i]{NEW}{TABS} ) {
80	    warn "new data should have no tabs in it at table line $i";
81	    $bad++;
82	}
83
84	if ( $DATA[$i]{NEW}{WORDS} != $DATA[$i]{OLD}{WORDS} ) {
85	    warn "word count shouldn't change upon tab expansion at table line $i";
86	    $bad++;
87	}
88    }
89    print $bad ? "not " : "", "ok 1\n";
90    return $bad;
91}
92
93sub check($$$$) {
94    die "expected 4 arguments" unless @_ == 4;
95    my ($found, $index, $version, $item) = @_;
96    my $expected = $DATA[$index]{$version}{$item};
97    return 1 if $found == $expected;
98    warn sprintf("%s line %d expected %d %s, found %d instead",
99		  ucfirst(lc($version)),
100			  $index,     $expected,
101					 lc($item),
102						 $found);
103    return 0;
104}
105
106sub check_data {
107
108    binmode(DATA, ":utf8") || die "can't binmode DATA to utf8: $!";
109    local($_);
110    while ( <DATA> ) {
111
112	my $bad = 0;
113
114	if ($. > $#DATA) {
115	    die "too many lines of data";
116	}
117
118	$DATA[$.]{OLD}{DATA} = $_;
119
120	my($char_count,  $byte_count, $chunk_count, $word_count, $tab_count);
121
122	$byte_count  = bytes::length($_);
123	$char_count  = length();
124	$chunk_count = () = /\X/g;
125	$word_count  = () = /(?:(?=\pL)\X)+/g;
126	$tab_count   = y/\t//;
127
128	$bad++ unless check($byte_count,  $., "OLD", "BYTES");
129	$bad++ unless check($char_count,  $., "OLD", "CHARS");
130	$bad++ unless check($chunk_count, $., "OLD", "CHUNKS");
131	$bad++ unless check($word_count,  $., "OLD", "WORDS");
132	$bad++ unless check($tab_count,   $., "OLD", "TABS");
133
134	$_ = expand($_);
135
136	$DATA[$.]{NEW}{DATA} = $_;
137
138	$byte_count  = bytes::length($_);
139	$char_count  = length();
140	$chunk_count = () = /\X/g;
141	$word_count  = () = /(?:(?=\pL)\X)+/g;
142	$tab_count   = y/\t//;
143
144	$bad++ unless check($byte_count,  $., "NEW", "BYTES");
145	$bad++ unless check($char_count,  $., "NEW", "CHARS");
146	$bad++ unless check($chunk_count, $., "NEW", "CHUNKS");
147	$bad++ unless check($word_count,  $., "NEW", "WORDS");
148	$bad++ unless check($tab_count,   $., "NEW", "TABS");
149
150	$_ = unexpand($_);
151
152	if ($_ ne $DATA[$.]{OLD}{DATA}) {
153	    warn "expand/unexpand round-trip equivalency failed at line $.";
154	    warn sprintf("  Expected:\n%s\n%v02x\n  But got:\n%s\n%v02x\n",
155		    ( $DATA[$.]{OLD}{DATA} ) x 2, ($_) x 2 );
156	    $bad++;
157	}
158
159	my $num = $. + 1;
160	print $bad ? "not " : "", "ok $num\n";
161	$Errors += $bad;
162
163    }
164
165}
166
167
168__DATA__
169	De los sos o̲j̲o̲s̲ 		tan fuertemientre l̲l̲o̲r̲a̲n̲d̲o̲,
170	tornava la cabeça		i estávalos catando.
171	Vio puertas abiertas		e uços sin cañados,
172	alcándaras vázias		sin pielles e sin mantos
173	e s̲i̲n̲ f̲a̲l̲c̲o̲n̲e̲s̲			e s̲i̲n̲ a̲d̲t̲o̲r̲e̲s̲ mudados.
174	Sospiró mio Çid,		ca mucho avie grandes cuidados.
175	Fabló mio Çid			bien e tan mesurado:
176       “grado a tí, s̳e̳ñ̳o̳r̳ p̳a̳d̳r̳e̳,	que estás en alto!
177	Esto me an buelto		mis enemigos malos.”
178