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