/[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.6 - (hide annotations) (download) (as text)
Fri Jan 25 16:04:39 2008 UTC (17 years, 5 months ago) by wakaba
Branch: MAIN
Changes since 1.5: +8 -8 lines
File MIME type: application/x-troff
++ whatpm/t/ChangeLog	25 Jan 2008 16:01:06 -0000
2008-01-26  Wakaba  <wakaba@suika.fam.cx>

	* css-visual.dat: Test data for 'padding', 'margin',
	and 'border' related shorthands are added.

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

	* CSS-Parser-1.t: |css-generated.dat| is added.
	(get_computed_style): The subject of |query_selector|
	should have been the document.

	* css-generated.dat: New test data.

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

++ whatpm/Whatpm/CSS/ChangeLog	25 Jan 2008 15:59:41 -0000
2008-01-26  Wakaba  <wakaba@suika.fam.cx>

	* Parser.pm: Return value of |serialize_multiple| methods
	are changed.
	('margin' serialize_multiple, 'padding' serialize_multiple):
	Implemented.
	('border-style' serialize_shorthand, 'border-color'
	serialize_shorthand, 'border-width' serialize_shorthand,
	'border-left' serialize_shorthand, 'border-top' serialize_shorthand,
	'border-bottom' serialize_shorthand, 'border-right'
	serialize_shorthand): New.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24