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