/[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.5 - (hide annotations) (download) (as text)
Thu Jan 24 13:09:00 2008 UTC (17 years, 6 months ago) by wakaba
Branch: MAIN
Changes since 1.4: +5 -5 lines
File MIME type: application/x-troff
++ whatpm/t/ChangeLog	24 Jan 2008 13:08:49 -0000
	* CSS-Parser-1.t: Default values are updated.

	* css-1.t: Tests for duplicate declarations are added.

	* css-visual.t: Some tests were incorrect.  Tests for 'margin'
	serialization and '+' in 'margin' are added.

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

++ whatpm/Whatpm/CSS/ChangeLog	24 Jan 2008 13:07:19 -0000
	* Parser.pm (parse_char_string): Treatement for non-important
	duplicate declarations was incorrect.
	(margin): Use 'margin' shorthand property for serializing
	margin-related properties if possible.  Support for the |+|
	sign in <'margin'> is added.

2008-01-24  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.1 )) {
23     print "# $file_name\n";
24     open my $file, '<', $file_name or die "$0: $file_name: $!";
25    
26     my $all_test = {document => {}, test => []};
27     my $test;
28     my $mode = 'data';
29     my $doc_id;
30     my $selectors;
31     while (<$file>) {
32     s/\x0D\x0A/\x0A/;
33     if (/^#data$/) {
34     undef $test;
35     $test->{data} = '';
36     push @{$all_test->{test}}, $test;
37     $mode = 'data';
38     } elsif (/#(csstext|cssom)$/) {
39     $test->{$1} = '';
40     $mode = $1;
41     } elsif (/#(computed(?>text)?) (\S+) (.+)$/) {
42     $test->{$1}->{$doc_id = $2}->{$selectors = $3} = '';
43     $mode = $1;
44     } elsif (/^#html (\S+)$/) {
45     undef $test;
46     $test->{format} = 'html';
47     $test->{data} = '';
48     $all_test->{document}->{$1} = $test;
49     $mode = 'data';
50 wakaba 1.2 } elsif (/^#errors$/) {
51     $test->{errors} = [];
52     $mode = 'errors';
53     $test->{data} =~ s/\x0D?\x0A\z//;
54 wakaba 1.4 } elsif (/^#option q$/) {
55     $test->{option}->{parse_mode} = 'q';
56 wakaba 1.1 } elsif (defined $test->{data} and /^$/) {
57     undef $test;
58     } else {
59     if ({data => 1, cssom => 1, csstext => 1}->{$mode}) {
60     $test->{$mode} .= $_;
61     } elsif ($mode eq 'computed' or $mode eq 'computedtext') {
62     $test->{$mode}->{$doc_id}->{$selectors} .= $_;
63 wakaba 1.2 } elsif ($mode eq 'errors') {
64     tr/\x0D\x0A//d;
65     push @{$test->{errors}}, $_;
66 wakaba 1.1 } else {
67     die "Line $.: $_";
68     }
69     }
70     }
71    
72     for my $data (values %{$all_test->{document}}) {
73     if ($data->{format} eq 'html') {
74     my $doc = $dom->create_document;
75     $doc->manakai_is_html (1);
76     $doc->inner_html ($data->{data});
77     $data->{document} = $doc;
78     } else {
79     die "Test data format $data->{format} is not supported";
80     }
81     }
82    
83     for my $test (@{$all_test->{test}}) {
84 wakaba 1.4 my ($p, $css_options) = get_parser ($test->{option}->{parse_mode});
85 wakaba 1.1
86 wakaba 1.2 my @actual_error;
87 wakaba 1.1 $p->{onerror} = sub {
88     my (%opt) = @_;
89 wakaba 1.2 my $uri = ${$opt{uri}};
90     $uri =~ s[^thismessage:/][];
91     push @actual_error, join ';',
92     $uri, $opt{token}->{line}, $opt{token}->{column},
93     $opt{level},
94     $opt{type} . (defined $opt{value} ? ','.$opt{value} : '');
95 wakaba 1.1 };
96    
97     my $ss = $p->parse_char_string ($test->{data});
98 wakaba 1.2
99     ok ((join "\n", @actual_error), (join "\n", @{$test->{errors} or []}),
100     "#result ($test->{data})");
101 wakaba 1.1
102     if (defined $test->{cssom}) {
103     my $actual = serialize_cssom ($ss);
104     ok $actual, $test->{cssom}, "#cssom ($test->{data})";
105     }
106    
107     if (defined $test->{csstext}) {
108     my $actual = $ss->css_text;
109     ok $actual, $test->{csstext}, "#csstext ($test->{data})";
110     }
111    
112     for my $doc_id (keys %{$test->{computed} or {}}) {
113     for my $selectors (keys %{$test->{computed}->{$doc_id}}) {
114     my ($window, $style) = get_computed_style
115     ($all_test, $doc_id, $selectors, $dom, $css_options, $ss);
116     ## NOTE: $window is the root object, so that we must keep it
117     ## referenced in this block.
118    
119     my $actual = serialize_style ($style, '');
120     my $expected = $DefaultComputed;
121     my $diff = $test->{computed}->{$doc_id}->{$selectors};
122     ($actual, $expected) = apply_diff ($actual, $expected, $diff);
123     ok $actual, $expected,
124     "#computed $doc_id $selectors ($test->{data})";
125     }
126     }
127    
128     for my $doc_id (keys %{$test->{computedtext} or {}}) {
129     for my $selectors (keys %{$test->{computedtext}->{$doc_id}}) {
130     my ($window, $style) = get_computed_style
131     ($all_test, $doc_id, $selectors, $dom, $css_options, $ss);
132     ## NOTE: $window is the root object, so that we must keep it
133     ## referenced in this block.
134    
135     my $actual = $style->css_text;
136     my $expected = $DefaultComputedText;
137     my $diff = $test->{computedtext}->{$doc_id}->{$selectors};
138     ($actual, $expected) = apply_diff ($actual, $expected, $diff);
139     "#computedtext $doc_id $selectors ($test->{data})";
140     ok $actual, $expected,
141     "#computedtext $doc_id $selectors ($test->{data})";
142     }
143     }
144     }
145     }
146    
147     my @longhand;
148     my @shorthand;
149     BEGIN {
150     @longhand = qw/
151     background-attachment background-color background-image
152     background-position-x background-position-y
153     background-repeat border-bottom-color
154     border-bottom-style border-bottom-width border-collapse
155     border-left-color
156     border-left-style border-left-width border-right-color
157     border-right-style border-right-width
158     -manakai-border-spacing-x -manakai-border-spacing-y
159     border-top-color border-top-style border-top-width bottom
160     caption-side clear color cursor direction display empty-cells float
161     font-family font-size font-style font-variant font-weight height left
162     letter-spacing line-height
163     list-style-image list-style-position list-style-type
164     margin-bottom margin-left margin-right margin-top
165     max-height max-width min-height min-width opacity -moz-opacity
166     orphans outline-color outline-style outline-width overflow
167     padding-bottom padding-left padding-right padding-top
168     page-break-after page-break-before page-break-inside
169     position right table-layout
170     text-align text-decoration text-indent text-transform
171     top unicode-bidi vertical-align visibility white-space width widows
172     word-spacing z-index
173     /;
174     @shorthand = qw/
175     background background-position
176     border border-color border-style border-width border-spacing
177     border-top border-right border-bottom border-left
178     font list-style margin outline padding
179     /;
180     $DefaultComputedText = q[ border-spacing: 0px;
181     background: transparent none repeat scroll 0% 0%;
182     border: 0px none -manakai-default;
183     border-collapse: separate;
184     bottom: auto;
185     caption-side: top;
186     clear: none;
187     color: -manakai-default;
188     cursor: auto;
189     direction: ltr;
190     display: inline;
191     empty-cells: show;
192     float: none;
193     font-family: -manakai-default;
194     font-size: 16px;
195     font-style: normal;
196     font-variant: normal;
197     font-weight: 400;
198     height: auto;
199     left: auto;
200     letter-spacing: normal;
201     line-height: normal;
202     list-style-image: none;
203     list-style-position: outside;
204     list-style-type: disc;
205 wakaba 1.5 margin: 0px;
206 wakaba 1.1 max-height: none;
207     max-width: none;
208     min-height: 0px;
209     min-width: 0px;
210     opacity: 1;
211     orphans: 2;
212     outline: 0px none invert;
213     overflow: visible;
214     padding-bottom: 0px;
215     padding-left: 0px;
216     padding-right: 0px;
217     padding-top: 0px;
218     page-break-after: auto;
219     page-break-before: auto;
220     page-break-inside: auto;
221     position: static;
222     right: auto;
223     table-layout: auto;
224     text-align: begin;
225     text-decoration: none;
226     text-indent: 0px;
227     text-transform: none;
228     top: auto;
229     unicode-bidi: normal;
230     vertical-align: baseline;
231     visibility: visible;
232     white-space: normal;
233     widows: 2;
234     width: auto;
235     word-spacing: normal;
236     z-index: auto;
237     ];
238     $DefaultComputed = $DefaultComputedText;
239     $DefaultComputed =~ s/^ /| /gm;
240     $DefaultComputed =~ s/;$//gm;
241     $DefaultComputed .= q[| -manakai-border-spacing-x: 0px
242     | -manakai-border-spacing-y: 0px
243     | -moz-opacity: 1
244     | background-attachment: scroll
245     | background-color: transparent
246     | background-image: none
247     | background-position-x: 0%
248     | background-position-y: 0%
249     | background-repeat: repeat
250     | border: 0px none -manakai-default
251     | border-top: 0px none -manakai-default
252     | border-right: 0px none -manakai-default
253     | border-bottom: 0px none -manakai-default
254     | border-left: 0px none -manakai-default
255     | border-bottom-color: -manakai-default
256     | border-bottom-style: none
257     | border-bottom-width: 0px
258     | border-left-color: -manakai-default
259     | border-left-style: none
260     | border-left-width: 0px
261     | border-right-color: -manakai-default
262     | border-right-style: none
263     | border-right-width: 0px
264     | border-top-color: -manakai-default
265     | border-top-style: none
266     | border-top-width: 0px
267     | border-color: -manakai-default
268     | border-style: none
269     | border-width: 0px
270     | float: none
271     | font: @@TODO
272     | list-style: @@TODO
273 wakaba 1.5 | margin-top: 0px
274     | margin-right: 0px
275     | margin-bottom: 0px
276     | margin-left: 0px
277 wakaba 1.1 | outline-color: invert
278     | outline-style: none
279     | outline-width: 0px
280     | padding: 1];
281     }
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     my $element = $doc->document_element->query_selector ($selectors);
440     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