/[suikacvs]/markup/html/whatpm/t/CSS-Parser-1.t
Suika

Contents of /markup/html/whatpm/t/CSS-Parser-1.t

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (hide annotations) (download) (as text)
Sun Jan 27 07:19:05 2008 UTC (17 years, 5 months ago) by wakaba
Branch: MAIN
Changes since 1.8: +2 -0 lines
File MIME type: application/x-troff
++ whatpm/t/ChangeLog	27 Jan 2008 07:19:02 -0000
	* CSS-Parser-1.t: Files |css-text.dat| and |css-paged.dat|
	are added.

	* css-visual.dat: New test data for 'background-position' are
	added.

	* css-text.dat: New test file.

	* css-paged.dat: New test file.

2008-01-27  Wakaba  <wakaba@suika.fam.cx>

++ whatpm/Whatpm/CSS/ChangeLog	27 Jan 2008 07:18:18 -0000
	* Parser.pm ($parse_color): Support for '+'.  HSL to RGB
	convertion was wrong.
	('orphans', 'background-position' parse): Support for '+'.

2008-01-27  Wakaba  <wakaba@suika.fam.cx>

1 wakaba 1.1 #!/usr/bin/perl
2     use strict;
3    
4     use lib qw[/home/wakaba/work/manakai2/lib]; ## TODO: ...
5    
6     use Test;
7    
8     BEGIN { plan tests => 548 }
9    
10     require Whatpm::CSS::Parser;
11     require Message::DOM::Window;
12    
13     require Message::DOM::DOMImplementation;
14     my $dom = Message::DOM::DOMImplementation->new;
15    
16     my $DefaultComputed;
17     my $DefaultComputedText;
18    
19     for my $file_name (map {"t/$_"} qw(
20     css-1.dat
21 wakaba 1.4 css-visual.dat
22 wakaba 1.6 css-generated.dat
23 wakaba 1.9 css-paged.dat
24     css-text.dat
25 wakaba 1.7 css-font.dat
26 wakaba 1.1 )) {
27     print "# $file_name\n";
28     open my $file, '<', $file_name or die "$0: $file_name: $!";
29    
30     my $all_test = {document => {}, test => []};
31     my $test;
32     my $mode = 'data';
33     my $doc_id;
34     my $selectors;
35     while (<$file>) {
36     s/\x0D\x0A/\x0A/;
37     if (/^#data$/) {
38     undef $test;
39     $test->{data} = '';
40     push @{$all_test->{test}}, $test;
41     $mode = 'data';
42     } elsif (/#(csstext|cssom)$/) {
43     $test->{$1} = '';
44     $mode = $1;
45     } elsif (/#(computed(?>text)?) (\S+) (.+)$/) {
46     $test->{$1}->{$doc_id = $2}->{$selectors = $3} = '';
47     $mode = $1;
48     } elsif (/^#html (\S+)$/) {
49     undef $test;
50     $test->{format} = 'html';
51     $test->{data} = '';
52     $all_test->{document}->{$1} = $test;
53     $mode = 'data';
54 wakaba 1.2 } elsif (/^#errors$/) {
55     $test->{errors} = [];
56     $mode = 'errors';
57     $test->{data} =~ s/\x0D?\x0A\z//;
58 wakaba 1.4 } elsif (/^#option q$/) {
59     $test->{option}->{parse_mode} = 'q';
60 wakaba 1.1 } elsif (defined $test->{data} and /^$/) {
61     undef $test;
62     } else {
63     if ({data => 1, cssom => 1, csstext => 1}->{$mode}) {
64     $test->{$mode} .= $_;
65     } elsif ($mode eq 'computed' or $mode eq 'computedtext') {
66     $test->{$mode}->{$doc_id}->{$selectors} .= $_;
67 wakaba 1.2 } elsif ($mode eq 'errors') {
68     tr/\x0D\x0A//d;
69     push @{$test->{errors}}, $_;
70 wakaba 1.1 } else {
71     die "Line $.: $_";
72     }
73     }
74     }
75    
76     for my $data (values %{$all_test->{document}}) {
77     if ($data->{format} eq 'html') {
78     my $doc = $dom->create_document;
79     $doc->manakai_is_html (1);
80     $doc->inner_html ($data->{data});
81     $data->{document} = $doc;
82     } else {
83     die "Test data format $data->{format} is not supported";
84     }
85     }
86    
87     for my $test (@{$all_test->{test}}) {
88 wakaba 1.4 my ($p, $css_options) = get_parser ($test->{option}->{parse_mode});
89 wakaba 1.1
90 wakaba 1.2 my @actual_error;
91 wakaba 1.1 $p->{onerror} = sub {
92     my (%opt) = @_;
93 wakaba 1.2 my $uri = ${$opt{uri}};
94     $uri =~ s[^thismessage:/][];
95     push @actual_error, join ';',
96     $uri, $opt{token}->{line}, $opt{token}->{column},
97     $opt{level},
98     $opt{type} . (defined $opt{value} ? ','.$opt{value} : '');
99 wakaba 1.1 };
100    
101     my $ss = $p->parse_char_string ($test->{data});
102 wakaba 1.2
103     ok ((join "\n", @actual_error), (join "\n", @{$test->{errors} or []}),
104     "#result ($test->{data})");
105 wakaba 1.1
106     if (defined $test->{cssom}) {
107     my $actual = serialize_cssom ($ss);
108     ok $actual, $test->{cssom}, "#cssom ($test->{data})";
109     }
110    
111     if (defined $test->{csstext}) {
112     my $actual = $ss->css_text;
113     ok $actual, $test->{csstext}, "#csstext ($test->{data})";
114     }
115    
116     for my $doc_id (keys %{$test->{computed} or {}}) {
117     for my $selectors (keys %{$test->{computed}->{$doc_id}}) {
118     my ($window, $style) = get_computed_style
119     ($all_test, $doc_id, $selectors, $dom, $css_options, $ss);
120     ## NOTE: $window is the root object, so that we must keep it
121     ## referenced in this block.
122    
123     my $actual = serialize_style ($style, '');
124     my $expected = $DefaultComputed;
125     my $diff = $test->{computed}->{$doc_id}->{$selectors};
126     ($actual, $expected) = apply_diff ($actual, $expected, $diff);
127     ok $actual, $expected,
128     "#computed $doc_id $selectors ($test->{data})";
129     }
130     }
131    
132     for my $doc_id (keys %{$test->{computedtext} or {}}) {
133     for my $selectors (keys %{$test->{computedtext}->{$doc_id}}) {
134     my ($window, $style) = get_computed_style
135     ($all_test, $doc_id, $selectors, $dom, $css_options, $ss);
136     ## NOTE: $window is the root object, so that we must keep it
137     ## referenced in this block.
138    
139     my $actual = $style->css_text;
140     my $expected = $DefaultComputedText;
141     my $diff = $test->{computedtext}->{$doc_id}->{$selectors};
142     ($actual, $expected) = apply_diff ($actual, $expected, $diff);
143     "#computedtext $doc_id $selectors ($test->{data})";
144     ok $actual, $expected,
145     "#computedtext $doc_id $selectors ($test->{data})";
146     }
147     }
148     }
149     }
150    
151     my @longhand;
152     my @shorthand;
153     BEGIN {
154     @longhand = qw/
155     background-attachment background-color background-image
156     background-position-x background-position-y
157     background-repeat border-bottom-color
158     border-bottom-style border-bottom-width border-collapse
159     border-left-color
160     border-left-style border-left-width border-right-color
161     border-right-style border-right-width
162     -manakai-border-spacing-x -manakai-border-spacing-y
163     border-top-color border-top-style border-top-width bottom
164     caption-side clear color cursor direction display empty-cells float
165     font-family font-size font-style font-variant font-weight height left
166     letter-spacing line-height
167     list-style-image list-style-position list-style-type
168     margin-bottom margin-left margin-right margin-top
169     max-height max-width min-height min-width opacity -moz-opacity
170     orphans outline-color outline-style outline-width overflow
171     padding-bottom padding-left padding-right padding-top
172     page-break-after page-break-before page-break-inside
173     position right table-layout
174     text-align text-decoration text-indent text-transform
175     top unicode-bidi vertical-align visibility white-space width widows
176     word-spacing z-index
177     /;
178     @shorthand = qw/
179     background background-position
180     border border-color border-style border-width border-spacing
181     border-top border-right border-bottom border-left
182     font list-style margin outline padding
183     /;
184     $DefaultComputedText = q[ border-spacing: 0px;
185     background: transparent none repeat scroll 0% 0%;
186     border: 0px none -manakai-default;
187     border-collapse: separate;
188     bottom: auto;
189     caption-side: top;
190     clear: none;
191     color: -manakai-default;
192     cursor: auto;
193     direction: ltr;
194     display: inline;
195     empty-cells: show;
196     float: none;
197     font-family: -manakai-default;
198     font-size: 16px;
199     font-style: normal;
200     font-variant: normal;
201     font-weight: 400;
202     height: auto;
203     left: auto;
204     letter-spacing: normal;
205     line-height: normal;
206     list-style-image: none;
207     list-style-position: outside;
208     list-style-type: disc;
209 wakaba 1.5 margin: 0px;
210 wakaba 1.1 max-height: none;
211     max-width: none;
212     min-height: 0px;
213     min-width: 0px;
214     opacity: 1;
215     orphans: 2;
216     outline: 0px none invert;
217     overflow: visible;
218 wakaba 1.6 padding: 0px;
219 wakaba 1.1 page-break-after: auto;
220     page-break-before: auto;
221     page-break-inside: auto;
222     position: static;
223     right: auto;
224     table-layout: auto;
225     text-align: begin;
226     text-decoration: none;
227     text-indent: 0px;
228     text-transform: none;
229     top: auto;
230     unicode-bidi: normal;
231     vertical-align: baseline;
232     visibility: visible;
233     white-space: normal;
234     widows: 2;
235     width: auto;
236     word-spacing: normal;
237     z-index: auto;
238     ];
239     $DefaultComputed = $DefaultComputedText;
240     $DefaultComputed =~ s/^ /| /gm;
241     $DefaultComputed =~ s/;$//gm;
242     $DefaultComputed .= q[| -manakai-border-spacing-x: 0px
243     | -manakai-border-spacing-y: 0px
244     | -moz-opacity: 1
245     | background-attachment: scroll
246     | background-color: transparent
247     | background-image: none
248 wakaba 1.8 | background-position: 0% 0%
249 wakaba 1.1 | background-position-x: 0%
250     | background-position-y: 0%
251     | background-repeat: repeat
252     | border-top: 0px none -manakai-default
253     | border-right: 0px none -manakai-default
254     | border-bottom: 0px none -manakai-default
255     | border-left: 0px none -manakai-default
256     | border-bottom-color: -manakai-default
257     | border-bottom-style: none
258     | border-bottom-width: 0px
259     | border-left-color: -manakai-default
260     | border-left-style: none
261     | border-left-width: 0px
262     | border-right-color: -manakai-default
263     | border-right-style: none
264     | border-right-width: 0px
265     | border-top-color: -manakai-default
266     | border-top-style: none
267     | border-top-width: 0px
268     | border-color: -manakai-default
269     | border-style: none
270     | border-width: 0px
271     | float: none
272 wakaba 1.7 | font: 400 16px -manakai-default
273 wakaba 1.6 | list-style: disc none outside
274 wakaba 1.5 | margin-top: 0px
275     | margin-right: 0px
276     | margin-bottom: 0px
277     | margin-left: 0px
278 wakaba 1.1 | outline-color: invert
279     | outline-style: none
280     | outline-width: 0px
281 wakaba 1.6 | padding-bottom: 0px
282     | padding-left: 0px
283     | padding-right: 0px
284     | padding-top: 0px];
285 wakaba 1.1 }
286    
287 wakaba 1.4 sub get_parser ($) {
288     my $parse_mode = shift;
289    
290 wakaba 1.1 my $p = Whatpm::CSS::Parser->new;
291 wakaba 1.4
292     if ($parse_mode eq 'q') {
293     $p->{unitless_px} = 1;
294     $p->{hashless_color} = 1;
295     }
296 wakaba 1.1
297     $p->{prop}->{$_} = 1 for (@longhand, @shorthand);
298     $p->{prop_value}->{display}->{$_} = 1 for qw/
299     block inline inline-block inline-table list-item none
300     table table-caption table-cell table-column table-column-group
301     table-header-group table-footer-group table-row table-row-group
302     /;
303     $p->{prop_value}->{position}->{$_} = 1 for qw/
304     absolute fixed relative static
305     /;
306     $p->{prop_value}->{float}->{$_} = 1 for qw/
307     left right none
308     /;
309     $p->{prop_value}->{clear}->{$_} = 1 for qw/
310     left right none both
311     /;
312     $p->{prop_value}->{direction}->{ltr} = 1;
313     $p->{prop_value}->{direction}->{rtl} = 1;
314     $p->{prop_value}->{'unicode-bidi'}->{$_} = 1 for qw/
315     normal bidi-override embed
316     /;
317     $p->{prop_value}->{overflow}->{$_} = 1 for qw/
318     visible hidden scroll auto
319     /;
320     $p->{prop_value}->{visibility}->{$_} = 1 for qw/
321     visible hidden collapse
322     /;
323     $p->{prop_value}->{'list-style-type'}->{$_} = 1 for qw/
324     disc circle square decimal decimal-leading-zero
325     lower-roman upper-roman lower-greek lower-latin
326     upper-latin armenian georgian lower-alpha upper-alpha none
327     /;
328     $p->{prop_value}->{'list-style-position'}->{outside} = 1;
329     $p->{prop_value}->{'list-style-position'}->{inside} = 1;
330     $p->{prop_value}->{'page-break-before'}->{$_} = 1 for qw/
331     auto always avoid left right
332     /;
333     $p->{prop_value}->{'page-break-after'}->{$_} = 1 for qw/
334     auto always avoid left right
335     /;
336     $p->{prop_value}->{'page-break-inside'}->{auto} = 1;
337     $p->{prop_value}->{'page-break-inside'}->{avoid} = 1;
338     $p->{prop_value}->{'background-repeat'}->{$_} = 1 for qw/
339     repeat repeat-x repeat-y no-repeat
340     /;
341     $p->{prop_value}->{'background-attachment'}->{scroll} = 1;
342     $p->{prop_value}->{'background-attachment'}->{fixed} = 1;
343     $p->{prop_value}->{'font-style'}->{normal} = 1;
344     $p->{prop_value}->{'font-style'}->{italic} = 1;
345     $p->{prop_value}->{'font-style'}->{oblique} = 1;
346     $p->{prop_value}->{'font-variant'}->{normal} = 1;
347     $p->{prop_value}->{'font-variant'}->{'small-caps'} = 1;
348     $p->{prop_value}->{'text-align'}->{$_} = 1 for qw/
349     left right center justify begin end
350     /;
351     $p->{prop_value}->{'text-transform'}->{$_} = 1 for qw/
352     capitalize uppercase lowercase none
353     /;
354     $p->{prop_value}->{'white-space'}->{$_} = 1 for qw/
355     normal pre nowrap pre-line pre-wrap
356     /;
357     $p->{prop_value}->{'text-decoration'}->{$_} = 1 for qw/
358     none blink underline overline line-through
359     /;
360     $p->{prop_value}->{'caption-side'}->{$_} = 1 for qw/
361     top bottom
362     /;
363     $p->{prop_value}->{'table-layout'}->{auto} = 1;
364     $p->{prop_value}->{'table-layout'}->{fixed} = 1;
365     $p->{prop_value}->{'border-collapse'}->{collapase} = 1;
366     $p->{prop_value}->{'border-collapse'}->{separate} = 1;
367     $p->{prop_value}->{'empty-cells'}->{show} = 1;
368     $p->{prop_value}->{'empty-cells'}->{hide} = 1;
369     $p->{prop_value}->{cursor}->{$_} = 1 for qw/
370     auto crosshair default pointer move e-resize ne-resize nw-resize n-resize
371     se-resize sw-resize s-resize w-resize text wait help progress
372     /;
373     for my $prop (qw/border-top-style border-left-style
374     border-bottom-style border-right-style outline-style/) {
375     $p->{prop_value}->{$prop}->{$_} = 1 for qw/
376     none hidden dotted dashed solid double groove ridge inset outset
377     /;
378     }
379     for my $prop (qw/color background-color
380     border-bottom-color border-left-color border-right-color
381     border-top-color border-color/) {
382     $p->{prop_value}->{$prop}->{transparent} = 1;
383     $p->{prop_value}->{$prop}->{flavor} = 1;
384     $p->{prop_value}->{$prop}->{'-manakai-default'} = 1;
385     }
386     $p->{prop_value}->{'outline-color'}->{invert} = 1;
387     $p->{prop_value}->{'outline-color'}->{'-manakai-invert-or-currentcolor'} = 1;
388     $p->{pseudo_class}->{$_} = 1 for qw/
389     active checked disabled empty enabled first-child first-of-type
390     focus hover indeterminate last-child last-of-type link only-child
391     only-of-type root target visited
392     lang nth-child nth-last-child nth-of-type nth-last-of-type not
393     -manakai-contains -manakai-current
394     /;
395     $p->{pseudo_element}->{$_} = 1 for qw/
396     after before first-letter first-line
397     /;
398    
399     my $css_options = {
400     prop => $p->{prop},
401     prop_value => $p->{prop_value},
402     pseudo_class => $p->{pseudo_class},
403     pseudo_element => $p->{pseudo_element},
404     };
405    
406     $p->{href} = 'thismessage:/';
407    
408     return ($p, $css_options);
409     } # get_parser
410    
411     sub serialize_cssom ($) {
412     my $ss = shift;
413    
414     if (defined $ss) {
415     if ($ss->isa ('Message::IF::CSSStyleSheet')) {
416     my $v = '';
417     for my $rule (@{$ss->css_rules}) {
418     my $indent = '';
419     if ($rule->type == $rule->STYLE_RULE) {
420     $v .= '| ' . $indent . '<' . $rule->selector_text . ">\n";
421     $v .= serialize_style ($rule->style, $indent . ' ');
422     } else {
423     die "Rule type @{[$rule->type]} is not supported";
424     }
425     }
426     return $v;
427     } else {
428     return '(' . (ref $ss) . ')';
429     }
430     } else {
431     return '(undef)';
432     }
433     } # serialize_cssom
434    
435     sub get_computed_style ($$$$$$) {
436     my ($all_test, $doc_id, $selectors, $dom, $css_options, $ss) = @_;
437    
438     my $doc = $all_test->{document}->{$doc_id}->{document};
439     unless ($doc) {
440     die "Test document $doc_id is not defined";
441     }
442    
443 wakaba 1.6 my $element = $doc->query_selector ($selectors);
444 wakaba 1.1 unless ($element) {
445     die "Element $selectors not found in document $doc_id";
446     }
447    
448     my $window = Message::DOM::Window->___new ($dom);
449     $window->___set_css_options ($css_options);
450     $window->___set_user_style_sheets ([$ss]);
451     $window->set_document ($doc);
452    
453 wakaba 1.3 my $style = $element->manakai_computed_style;
454 wakaba 1.1 return ($window, $style);
455     } # get_computed_style
456    
457     sub serialize_style ($$) {
458     my ($style, $indent) = @_;
459    
460     ## TODO: check @$style
461    
462     my @v;
463     for (map {get_dom_names ($_)} @shorthand, @longhand) {
464     my $dom = $_->[1];
465     push @v, [$_->[0], $dom, $style->$dom,
466     $style->get_property_priority ($_->[0])];
467     $v[-1]->[3] = ' !' . $v[-1]->[3] if length $v[-1]->[3];
468     }
469     return join '', map {"| $indent$_->[0]: $_->[2]$_->[3]\n"}
470     sort {$a->[0] cmp $b->[0]} grep {length $_->[2]} @v;
471     } # serialize_style
472    
473     sub get_dom_names ($) {
474     my $dom_name = $_[0];
475     if ($_[0] eq 'float') {
476     return ([$_[0] => 'css_float'], [$_[0] => 'style_float']);
477     }
478    
479     $dom_name =~ tr/-/_/;
480     return ([$_[0] => $dom_name]);
481     } # get_dom_names
482    
483     sub apply_diff ($$$) {
484     my ($actual, $expected, $diff) = @_;
485     my @actual = split /[\x0D\x0A]+/, $actual;
486     my @expected = split /[\x0D\x0A]+/, $expected;
487     my @diff = split /[\x0D\x0A]+/, $diff;
488     for (@diff) {
489     if (s/^-//) {
490     push @actual, $_;
491     } elsif (s/^\+//) {
492     push @expected, $_;
493     } else {
494     die "Invalid diff line: $_";
495     }
496     }
497     $actual = join "\n", sort {$a cmp $b} @actual;
498     $expected = join "\n", sort {$a cmp $b} @expected;
499     ($actual, $expected);
500     } # apply_diff

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24