Commit | Line | Data |
---|---|---|
351625bd SP |
1 | BEGIN { |
2 | if($ENV{PERL_CORE}) { | |
3 | chdir 't'; | |
4 | @INC = '../lib'; | |
5 | } | |
6 | } | |
7 | ||
8 | use strict; | |
9 | use Test; | |
10 | BEGIN { plan tests => 136 }; | |
11 | ||
12 | #use Pod::Simple::Debug (5); | |
13 | ||
14 | #sub Pod::Simple::MANY_LINES () {1} | |
15 | #sub Pod::Simple::PullParser::DEBUG () {1} | |
16 | ||
17 | ||
18 | use Pod::Simple::PullParser; | |
19 | ||
20 | sub pump_it_up { | |
21 | my $p = Pod::Simple::PullParser->new; | |
22 | $p->set_source( \( $_[0] ) ); | |
23 | my(@t, $t); | |
24 | while($t = $p->get_token) { push @t, $t } | |
25 | print "# Count of tokens: ", scalar(@t), "\n"; | |
26 | print "# I.e., {", join("\n# + ", | |
27 | map ref($_) . ": " . $_->dump, @t), "} \n"; | |
28 | return @t; | |
29 | } | |
30 | ||
31 | my @t; | |
32 | ||
33 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |
34 | ||
35 | @t = pump_it_up(qq{\n\nProk\n\n=head1 Things\n\n=cut\n\nBzorch\n\n}); | |
36 | ||
37 | if(not( | |
38 | ok scalar( grep { ref $_ and $_->can('type') } @t), 5 | |
39 | )) { | |
40 | ok 0,1, "Wrong token count. Failing subsequent tests.\n"; | |
41 | for ( 1 .. 12 ) {ok 0} | |
42 | } else { | |
43 | ok $t[0]->type, 'start'; | |
44 | ok $t[1]->type, 'start'; | |
45 | ok $t[2]->type, 'text'; | |
46 | ok $t[3]->type, 'end'; | |
47 | ok $t[4]->type, 'end'; | |
48 | ||
49 | ok $t[0]->tagname, 'Document'; | |
50 | ok $t[1]->tagname, 'head1'; | |
51 | ok $t[2]->text, 'Things'; | |
52 | ok $t[3]->tagname, 'head1'; | |
53 | ok $t[4]->tagname, 'Document'; | |
54 | ||
55 | ok $t[0]->attr('start_line'), '5'; | |
56 | ok $t[1]->attr('start_line'), '5'; | |
57 | } | |
58 | ||
59 | ||
60 | ||
61 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |
62 | @t = pump_it_up( | |
63 | qq{Woowoo\n\n=over\n\n=item *\n\nStuff L<HTML::TokeParser>\n\n} | |
64 | . qq{=item *\n\nThings I<like that>\n\n=back\n\n=cut\n\n} | |
65 | ); | |
66 | ||
67 | if( | |
68 | not( ok scalar( grep { ref $_ and $_->can('type') } @t) => 16 ) | |
69 | ) { | |
70 | ok 0,1, "Wrong token count. Failing subsequent tests.\n"; | |
71 | for ( 1 .. 32 ) {ok 0} | |
72 | } else { | |
73 | ok $t[ 0]->type, 'start'; | |
74 | ok $t[ 1]->type, 'start'; | |
75 | ok $t[ 2]->type, 'start'; | |
76 | ok $t[ 3]->type, 'text'; | |
77 | ok $t[ 4]->type, 'start'; | |
78 | ok $t[ 5]->type, 'text'; | |
79 | ok $t[ 6]->type, 'end'; | |
80 | ok $t[ 7]->type, 'end'; | |
81 | ||
82 | ok $t[ 8]->type, 'start'; | |
83 | ok $t[ 9]->type, 'text'; | |
84 | ok $t[10]->type, 'start'; | |
85 | ok $t[11]->type, 'text'; | |
86 | ok $t[12]->type, 'end'; | |
87 | ok $t[13]->type, 'end'; | |
88 | ok $t[14]->type, 'end'; | |
89 | ok $t[15]->type, 'end'; | |
90 | ||
91 | ||
92 | ||
93 | ok $t[ 0]->tagname, 'Document'; | |
94 | ok $t[ 1]->tagname, 'over-bullet'; | |
95 | ok $t[ 2]->tagname, 'item-bullet'; | |
96 | ok $t[ 3]->text, 'Stuff '; | |
97 | ok $t[ 4]->tagname, 'L'; | |
98 | ok $t[ 5]->text, 'HTML::TokeParser'; | |
99 | ok $t[ 6]->tagname, 'L'; | |
100 | ok $t[ 7]->tagname, 'item-bullet'; | |
101 | ||
102 | ok $t[ 8]->tagname, 'item-bullet'; | |
103 | ok $t[ 9]->text, 'Things '; | |
104 | ok $t[10]->tagname, 'I'; | |
105 | ok $t[11]->text, 'like that'; | |
106 | ok $t[12]->tagname, 'I'; | |
107 | ok $t[13]->tagname, 'item-bullet'; | |
108 | ok $t[14]->tagname, 'over-bullet'; | |
109 | ok $t[15]->tagname, 'Document'; | |
110 | ||
111 | ok $t[4]->attr("type"), "pod"; | |
112 | } | |
113 | ||
114 | ||
115 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |
116 | { | |
117 | print "# Testing unget_token\n"; | |
118 | ||
119 | my $p = Pod::Simple::PullParser->new; | |
120 | $p->set_source( \qq{\nBzorch\n\n=pod\n\nLala\n\n\=cut\n} ); | |
121 | ||
122 | ok 1; | |
123 | my $t; | |
124 | $t = $p->get_token; | |
125 | ok $t && $t->type, 'start'; | |
126 | ok $t && $t->tagname, 'Document'; | |
127 | print "# ungetting ($t).\n"; | |
128 | $p->unget_token($t); | |
129 | ok 1; | |
130 | ||
131 | $t = $p->get_token; | |
132 | ok $t && $t->type, 'start'; | |
133 | ok $t && $t->tagname, 'Document'; | |
134 | my @to_save = ($t); | |
135 | ||
136 | $t = $p->get_token; | |
137 | ok $t && $t->type, 'start'; | |
138 | ok $t && $t->tagname, 'Para'; | |
139 | push @to_save, $t; | |
140 | ||
141 | print "# ungetting (@to_save).\n"; | |
142 | $p->unget_token(@to_save); | |
143 | splice @to_save; | |
144 | ||
145 | ||
146 | $t = $p->get_token; | |
147 | ok $t && $t->type, 'start'; | |
148 | ok $t && $t->tagname, 'Document'; | |
149 | ||
150 | $t = $p->get_token; | |
151 | ok $t && $t->type, 'start'; | |
152 | ok $t && $t->tagname, 'Para'; | |
153 | ||
154 | ok 1; | |
155 | ||
156 | } | |
157 | ||
158 | ||
159 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |
160 | ||
161 | { | |
162 | print "# Testing pullparsing from an arrayref\n"; | |
163 | my $p = Pod::Simple::PullParser->new; | |
164 | ok 1; | |
165 | $p->set_source( ['','Bzorch', '','=pod', '', 'Lala', 'zaza', '', '=cut'] ); | |
166 | ok 1; | |
167 | my( @t, $t ); | |
168 | while($t = $p->get_token) { | |
169 | print "# Got a token: ", $t->dump, "\n#\n"; | |
170 | push @t, $t; | |
171 | } | |
172 | ok scalar(@t), 5; # count of tokens | |
173 | ok $t[0]->type, 'start'; | |
174 | ok $t[1]->type, 'start'; | |
175 | ok $t[2]->type, 'text'; | |
176 | ok $t[3]->type, 'end'; | |
177 | ok $t[4]->type, 'end'; | |
178 | ||
179 | ok $t[0]->tagname, 'Document'; | |
180 | ok $t[1]->tagname, 'Para'; | |
181 | ok $t[2]->text, 'Lala zaza'; | |
182 | ok $t[3]->tagname, 'Para'; | |
183 | ok $t[4]->tagname, 'Document'; | |
184 | ||
185 | } | |
186 | ||
187 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |
188 | ||
189 | { | |
190 | print "# Testing pullparsing from an arrayref with terminal newlines\n"; | |
191 | my $p = Pod::Simple::PullParser->new; | |
192 | ok 1; | |
193 | $p->set_source( [ map "$_\n", | |
194 | '','Bzorch', '','=pod', '', 'Lala', 'zaza', '', '=cut'] ); | |
195 | ok 1; | |
196 | my( @t, $t ); | |
197 | while($t = $p->get_token) { | |
198 | print "# Got a token: ", $t->dump, "\n#\n"; | |
199 | push @t, $t; | |
200 | } | |
201 | ok scalar(@t), 5; # count of tokens | |
202 | ok $t[0]->type, 'start'; | |
203 | ok $t[1]->type, 'start'; | |
204 | ok $t[2]->type, 'text'; | |
205 | ok $t[3]->type, 'end'; | |
206 | ok $t[4]->type, 'end'; | |
207 | ||
208 | ok $t[0]->tagname, 'Document'; | |
209 | ok $t[1]->tagname, 'Para'; | |
210 | ok $t[2]->text, 'Lala zaza'; | |
211 | ok $t[3]->tagname, 'Para'; | |
212 | ok $t[4]->tagname, 'Document'; | |
213 | ||
214 | } | |
215 | ||
216 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |
217 | ||
218 | END { unlink "temp.pod" } | |
219 | { | |
220 | print "# Testing pullparsing from a file\n"; | |
221 | my $p = Pod::Simple::PullParser->new; | |
222 | ok 1; | |
223 | open(OUT, ">temp.pod") || die "Can't write-open temp.pod: $!"; | |
224 | print OUT | |
225 | map "$_\n", | |
226 | '','Bzorch', '','=pod', '', 'Lala', 'zaza', '', '=cut' | |
227 | ; | |
228 | close(OUT); | |
229 | ok 1; | |
230 | sleep 1; | |
231 | ||
232 | $p->set_source("temp.pod"); | |
233 | ||
234 | my( @t, $t ); | |
235 | while($t = $p->get_token) { | |
236 | print "# Got a token: ", $t->dump, "\n#\n"; | |
237 | push @t, $t; | |
238 | print "# That's token number ", scalar(@t), "\n"; | |
239 | } | |
240 | ok scalar(@t), 5; # count of tokens | |
241 | ok $t[0]->type, 'start'; | |
242 | ok $t[1]->type, 'start'; | |
243 | ok $t[2]->type, 'text'; | |
244 | ok $t[3]->type, 'end'; | |
245 | ok $t[4]->type, 'end'; | |
246 | ||
247 | ok $t[0]->tagname, 'Document'; | |
248 | ok $t[1]->tagname, 'Para'; | |
249 | ok $t[2]->text, 'Lala zaza'; | |
250 | ok $t[3]->tagname, 'Para'; | |
251 | ok $t[4]->tagname, 'Document'; | |
252 | ||
253 | } | |
254 | ||
255 | # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ | |
256 | ||
257 | { | |
258 | print "# Testing pullparsing from a glob\n"; | |
259 | my $p = Pod::Simple::PullParser->new; | |
260 | ok 1; | |
261 | open(IN, "<temp.pod") || die "Can't read-open temp.pod: $!"; | |
262 | $p->set_source(*IN); | |
263 | ||
264 | my( @t, $t ); | |
265 | while($t = $p->get_token) { | |
266 | print "# Got a token: ", $t->dump, "\n#\n"; | |
267 | push @t, $t; | |
268 | print "# That's token number ", scalar(@t), "\n"; | |
269 | } | |
270 | ok scalar(@t), 5; # count of tokens | |
271 | ok $t[0]->type, 'start'; | |
272 | ok $t[1]->type, 'start'; | |
273 | ok $t[2]->type, 'text'; | |
274 | ok $t[3]->type, 'end'; | |
275 | ok $t[4]->type, 'end'; | |
276 | ||
277 | ok $t[0]->tagname, 'Document'; | |
278 | ok $t[1]->tagname, 'Para'; | |
279 | ok $t[2]->text, 'Lala zaza'; | |
280 | ok $t[3]->tagname, 'Para'; | |
281 | ok $t[4]->tagname, 'Document'; | |
282 | close(IN); | |
283 | ||
284 | } | |
285 | ||
286 | # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ | |
287 | ||
288 | { | |
289 | print "# Testing pullparsing from a globref\n"; | |
290 | my $p = Pod::Simple::PullParser->new; | |
291 | ok 1; | |
292 | open(IN, "<temp.pod") || die "Can't read-open temp.pod: $!"; | |
293 | $p->set_source(\*IN); | |
294 | ||
295 | my( @t, $t ); | |
296 | while($t = $p->get_token) { | |
297 | print "# Got a token: ", $t->dump, "\n#\n"; | |
298 | push @t, $t; | |
299 | print "# That's token number ", scalar(@t), "\n"; | |
300 | } | |
301 | ok scalar(@t), 5; # count of tokens | |
302 | ok $t[0]->type, 'start'; | |
303 | ok $t[1]->type, 'start'; | |
304 | ok $t[2]->type, 'text'; | |
305 | ok $t[3]->type, 'end'; | |
306 | ok $t[4]->type, 'end'; | |
307 | ||
308 | ok $t[0]->tagname, 'Document'; | |
309 | ok $t[1]->tagname, 'Para'; | |
310 | ok $t[2]->text, 'Lala zaza'; | |
311 | ok $t[3]->tagname, 'Para'; | |
312 | ok $t[4]->tagname, 'Document'; | |
313 | close(IN); | |
314 | ||
315 | } | |
316 | ||
317 | # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ | |
318 | ||
319 | { | |
320 | print "# Testing pullparsing from a filehandle\n"; | |
321 | my $p = Pod::Simple::PullParser->new; | |
322 | ok 1; | |
323 | open(IN, "<temp.pod") || die "Can't read-open temp.pod: $!"; | |
324 | $p->set_source(*IN{IO}); | |
325 | ||
326 | my( @t, $t ); | |
327 | while($t = $p->get_token) { | |
328 | print "# Got a token: ", $t->dump, "\n#\n"; | |
329 | push @t, $t; | |
330 | print "# That's token number ", scalar(@t), "\n"; | |
331 | } | |
332 | ok scalar(@t), 5; # count of tokens | |
333 | ok $t[0]->type, 'start'; | |
334 | ok $t[1]->type, 'start'; | |
335 | ok $t[2]->type, 'text'; | |
336 | ok $t[3]->type, 'end'; | |
337 | ok $t[4]->type, 'end'; | |
338 | ||
339 | ok $t[0]->tagname, 'Document'; | |
340 | ok $t[1]->tagname, 'Para'; | |
341 | ok $t[2]->text, 'Lala zaza'; | |
342 | ok $t[3]->tagname, 'Para'; | |
343 | ok $t[4]->tagname, 'Document'; | |
344 | close(IN); | |
345 | ||
346 | } | |
347 | ||
348 | ||
349 | ||
350 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |
351 | ||
352 | ||
353 | print "# Wrapping up... one for the road...\n"; | |
354 | ok 1; | |
355 | print "# --- Done with ", __FILE__, " --- \n"; | |
356 | ||
357 | __END__ | |
358 |