1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
|
#!/usr/bin/perl -T
use strict; use warnings; no warnings qw 'qw regexp once utf8 parenthesis';
our $tests;
BEGIN { ++$INC{'tests.pm'} }
sub tests::VERSION { $tests += pop };
use Test::More;
plan tests => $tests;
use tests 1; # use
use_ok 'CSS::DOM::Value', ':all';
require CSS::DOM::Value::List;
require CSS::DOM::Value::Primitive;
use tests 4; # constants
{
my $x;
for (qw/ CSS_INHERIT CSS_PRIMITIVE_VALUE CSS_VALUE_LIST
CSS_CUSTOM /) {
eval "is $_, " . $x++ . ", '$_'";
}
}
use tests 2; # constructor & isa
isa_ok +CSS::DOM::Value->new(type => &CSS_INHERIT), 'CSS::DOM::Value';
isa_ok +CSS::DOM::Value->new(type => &CSS_CUSTOM, value => "top left"),
'CSS::DOM::Value';
# --- cssText and cssValueType --- #
# Each subclass implements them itself, so I have to test each case. And I
# also have to make sure that getPropertyCSSValue produces the right
# thing, too.
require CSS::DOM::Style;
require CSS::DOM::PropertyParser;
my $s = new CSS::DOM::Style
property_parser => my $spec = $CSS::DOM::PropertyParser::Default;
# The default parser has no properties with a simple string, attr or
# counter value. They all take a list. So we add a few just to make test-
# ing easier:
$spec->add_property(s => {
format => '<string>',
});
$spec->add_property(a => {
format => '<attr>',
});
$spec->add_property(c => {
format => '<counter>',
});
# This runs 4 tests if the $property is specified and accepts $valstr.
# It runs 2 otherwise.
sub test_value {
my($s,$property,$class,$args,$valstr,$type,$name) = @_;
my $donefirst;
$s->setProperty($property, $valstr) if $property;
for my $val (
"CSS::DOM::Value$class"->new( @$args ),
$property ? $s->getPropertyCSSValue($property) : ()
) {
$name .= " (from getPCV)" x $donefirst++;
is $val->cssText, $valstr, "$name ->cssText";
is $val->cssValueType, $type,
"$name ->cssValueType";
}
}
use tests 8;
test_value $s,"top","", [type => &CSS_INHERIT], 'inherit', &CSS_INHERIT,
'inherit';
test_value $s,"background-position", "",
[type=>&CSS_CUSTOM,value=>"top left"],
'top left', &CSS_CUSTOM, 'custom value';
use tests 130;
my $css_num = &CSS::DOM::Value::Primitive::CSS_NUMBER;
for( #constant constructor val arg prop css str test name
[ number => '73' , 'z-index', '73' , 'number' ],
[ percentage => '73' , 'top' , '73%' , '%' ],
[ ems => '73' , 'top' , '73em' , 'em' ],
[ exs => '73' , 'top' , '73ex' , 'ex' ],
[ px => '73' , 'top' , '73px' , 'px' ],
[ cm => '73' , 'top' , '73cm' , 'cm' ],
[ mm => '73' , 'top' , '73mm' , 'mm' ],
[ in => '73' , 'top' , '73in' , 'inch' ],
[ pt => '73' , 'top' , '73pt' , 'point' ],
[ pc => '73' , 'top' , '73pc' , 'pica' ],
[ deg => '73' , 'azimuth', '73deg' , 'degree' ],
[ rad => '73' , 'azimuth', '73rad' , 'radian' ],
[ grad => '73' , 'azimuth', '73grad' , 'grad' ],
[ s => '73' , 'pause-after', '73s' , 'second' ],
[ ms => '73' , 'pause-after', '73ms' , 'ms' ],
[ Hz => '73' , 'pitch' , '73Hz' , 'hertz' ],
[ kHz => '73' , 'pitch' , '73kHz' , 'kHertz' ],
[ dimension => ['73', 'wob' ], '' , '73wob' , 'misc dim' ],
[ string => '73' , 's' , "'73'" , 'string' ],
[ uri => '73' , 'cue-after', "url(73)", 'URI' ],
[ ident => 'red' , 'color' , "red" , 'ident' ],
[ attr => 'red' , 'a' , "attr(red)", 'attr' ],
[ counter => ['red' ], 'c' , 'counter(red)', 'counter' ],
[ counter => ['red',undef,'lower-roman'], 'c',
'counter(red, lower-roman)', 'counter with style'],
[ counter => ['red','. '], 'c',
"counters(red, '. ')", 'counters'],
[ counter => ['red','. ','upper-latin'], 'c',
"counters(red, '. ', upper-latin)", 'counters with style'],
[ rect => [
[type=>&CSS::DOM::Value::Primitive::CSS_PX,value=>1],
[type=>&CSS::DOM::Value::Primitive::CSS_EMS,value=>2],
[type=>&CSS::DOM::Value::Primitive::CSS_IDENT,value=>'auto'],
[type=>&CSS::DOM::Value::Primitive::CSS_CM,value=>4],
], 'clip', "rect(1px, 2em, auto, 4cm)", 'rect'],
[ rgbcolor => 'red' , 'color' , 'red' , 'colour (ident)'],
[ rgbcolor => '#fff' , 'color' , '#fff', 'colour (#hhh)' ],
[ rgbcolor => '#abcdef' , 'color', '#abcdef', 'colour (#hhhhhh)'],
[ rgbcolor => [
[type=>$css_num,value=>255],
[type=>$css_num,value=>0],
[type=>$css_num,value=>0]
], 'color', 'rgb(255, 0, 0)', 'colour (rgb)'],
[ rgbcolor => [
[type=>$css_num,value=>255],
[type=>$css_num,value=>0],
[type=>$css_num,value=>0],
[type=>$css_num,value=>.5]
], 'color', 'rgba(255, 0, 0, 0.5)', 'colour (rgba)'],
[ ident => 'activeborder' , 'color', 'activeborder', 'system colour'],
) {
test_value $s, $$_[2], "::Primitive",
[
type =>
&{\&{"CSS::DOM::Value::Primitive::CSS_\U$$_[0]"}},
value => $$_[1],
],
$$_[3], &CSS_PRIMITIVE_VALUE, $$_[4]
}
use tests 20;
test_value $s,"counter-increment","::List", [
separator => ' ', values => [
[type => &CSS::DOM::Value::Primitive::CSS_IDENT, value => 'open-quote'],
[type => &CSS::DOM::Value::Primitive::CSS_NUMBER, value => '8'],
]
], "open-quote 8", &CSS_VALUE_LIST, 'space-separated list';
test_value $s,"cursor","::List", [
separator => ', ', values => [
[type => &CSS::DOM::Value::Primitive::CSS_URI, value => 'frew'],
[type => &CSS::DOM::Value::Primitive::CSS_IDENT, value => 'crosshair'],
]
], "url(frew), crosshair", &CSS_VALUE_LIST, 'comma-separated list';
test_value $s,"content","::List", [
separator => ', ', values => [
[type => &CSS::DOM::Value::Primitive::CSS_URI, value => 'cror'],
]
], "url(cror)", &CSS_VALUE_LIST, 'single-valued list';
test_value $s,"font-family","::List", [
separator => ', ', values => [
[type => &CSS::DOM::Value::Primitive::CSS_STRING, value => 'dat drin',
css => 'dat drin'],
]
], "dat drin", &CSS_VALUE_LIST,
'single-valued nominally comma-separated list';
test_value $s,"counter-reset","::List", [
separator => ' ', values => []
], 'none', &CSS_VALUE_LIST,
'empty list';
use tests 14; # writing cssText on inherit/custom values
{
my $v = new CSS::DOM::Value type => &CSS_INHERIT;
ok !eval{ $v->cssText('aaa'); 1 },
'setting cssText on an unowned css value object dies';
isa_ok $@, 'CSS::DOM::Exception', 'class of error after cssText dies';
cmp_ok $@, '==', &CSS::DOM::Exception::NO_MODIFICATION_ALLOWED_ERR,
'and the right type of error, too (after cssText dies)';
$v = new CSS::DOM::Value type => &CSS_INHERIT, owner => $s;
ok !eval{ $v->cssText('aaa'); 1 },
'setting cssText on a css value object with no property dies';
isa_ok $@, 'CSS::DOM::Exception',
'class of error after cssText dies (val with no prop)';
cmp_ok $@, '==', &CSS::DOM::Exception::NO_MODIFICATION_ALLOWED_ERR,
'and the right type of error, too (after cssText dies [val w/no prop])';
$s->backgroundPosition('inherit');
$v = $s->getPropertyCSSValue('background-position');
$v->cssText('top left'); # We write it twice on purpose, to make sure the
$v->cssText('top left'); # change in type did not discard the
is $s->backgroundPosition, 'top left', # internal owner attribute.
'value->cssText("top left") sets the owner CSS property';
is $v->cssValueType, &CSS_CUSTOM, ' and the value type';
is $v->cssText, 'top left', ' and the value object\'s own cssText';
$s->backgroundColor('inherit');
$v = $s->getPropertyCSSValue('background-color');
$v->cssText('red');
is $s->backgroundColor, 'red',
'setting the cssText of an inherit value to a colour changes the prop';
is $v->cssText, 'red',
'setting the cssText of an inherit value changes the cssText thereof';
is $v->cssValueType, &CSS_PRIMITIVE_VALUE,
'value type after setting an inherit value to a colour';
isa_ok $v, "CSS::DOM::Value::Primitive",
'object class after setting an inherit value to a colour';
$s->backgroundColor('inherit');
my $called;
$s->modification_handler(sub { ++$called });
$s->getPropertyCSSValue('background-color')->cssText('red');
is $called, 1,
'modification_handler is called when a CSS::DOM::Value changes';
}
use tests 30; # writing cssText on ‘primitive’ values
{
my $v = new CSS::DOM::Value::Primitive
type => &CSS::DOM::Value::Primitive::CSS_NUMBER, value => 43;
ok !eval{ $v->cssText('aaa'); 1 },
'setting cssText on an unowned primitive value object dies';
isa_ok $@, 'CSS::DOM::Exception',
'class of error after primitive->cssText dies';
cmp_ok $@, '==', &CSS::DOM::Exception::NO_MODIFICATION_ALLOWED_ERR,
'and the right type of error, too (after primitive->cssText dies)';
$s->backgroundImage('url(dwow)');
$v = $s->getPropertyCSSValue('background-image');
is $v->cssText('none'), 'url(dwow)',
'setting cssText returns the old value';
is $s->backgroundImage, 'none',
'prim_value->cssText("...") sets the owner CSS property';
is $v->primitiveType, &CSS::DOM::Value::Primitive::CSS_IDENT,
' prim->cssText sets the “primitive” type';
is $v->cssText, 'none',
' prim->cssText sets the value object\'s own cssText';
# We re-use the same value on purpose, to make sure the change in type did
# not discard the internal owner attribute.
$v->cssText('inherit');
is $s->backgroundImage, 'inherit',
'setting the cssText of a primitive value to inherit changes the prop';
is $v->cssText, 'inherit',
'setting the cssText of a prim val to inherit changes its cssText';
is $v->cssValueType, &CSS_INHERIT,
'value type after setting a primitive value to inherit';
isa_ok $v, "CSS::DOM::Value",
'object class after setting a primitive value to inherit';
$s->clip('rect(0,0,0,0)');
$v = $s->getPropertyCSSValue('clip')->top;
$v->cssText('red');
is $v->cssText, 0,
'setting cssText on a sub-value of a rect to a colour does nothing';
$v->cssText(50);
is $v->cssText, 0,
'setting cssText on a rect’s sub-value to a non-zero num does nothing';
$v->cssText('5px');
is $v->cssText, '5px',
'setting cssText on a sub-value of a rect to 5px works';
is $v->primitiveType, &CSS::DOM::Value::Primitive::CSS_PX,
'setting cssText on a sub-value of a rect to 5px changes the prim type';
like $s->clip, qr/^rect\(5px,\s*0,\s*0,\s*0\)\z/,
'setting cssText on a sub-value of a rect changes the prop that owns it';
$v->cssText('auto');
is $v->cssText, 'auto', 'rect sub-values can be set to auto';
$v->cssText('bdelp');
is $v->cssText, 'auto', 'but not to any other identifier';
$s->color('#c0ffee');
$v = (my $clr = $s->getPropertyCSSValue('color'))->red;
$v->cssText('red');
is $v->cssText, 192,
'setting cssText on a sub-value of a colour to a colour does nothing';
$v->cssText('255');
is $v->cssText, '255',
'setting cssText on a sub-value of a colour to 255 works';
is $clr->cssText, '#ffffee',
'changing a colour’s sub-value sets the colour’s cssText';
$v->cssText('50%');
is $v->cssText, '50%',
'setting cssText on a sub-value of a colour to 50% works';
is $v->primitiveType, &CSS::DOM::Value::Primitive::CSS_PERCENTAGE,
'changing the cssText of a colour’s sub-value changes the prim type';
like $clr->cssText, qr/^rgb\(127.5,\s*255,\s*238\)\z/,
'the colour’s cssText after making the subvalues mixed numbers & %’s';
$v = $clr->alpha;
$v->cssText('50%');
is $v->cssText, 1,
'alpha values ignore assignments of percentage values to cssText';
$v->cssText(.5);
is $v->cssText, .5,
'but number assignments (to alpha values’ cssText) work';
like $clr->cssText, qr/^rgba\(127.5,\s*255,\s*238,\s*0.5\)\z/,
'the colour’s cssText after making the subvalues mixed numbers & %’s';
$v = $s->getPropertyCSSValue('color');
$v->cssText('activeborder');;
is $v->primitiveType, &CSS::DOM::Value::Primitive::CSS_IDENT,
'setting a colour property’s cssText to a sys. colour makes it an ident';
$s->backgroundColor('red');
my $called;
$s->modification_handler(sub { ++$called });
$s->getPropertyCSSValue('background-color')->cssText('white');
is $called, 1,
"modification_handler is called when a ‘primitive’ value changes";
# Bug in 0.08 and 0.09: non-void context causes cssText not to write
# anything if the existing value is a string and there is no existing
# serialisation recorded.
$v = new CSS::DOM::Value::Primitive::
type => &CSS::DOM::Value::Primitive::CSS_STRING,
value => 'nin',
owner => $s,
property => 's',
;
scalar $v->cssText("'squow'");
is $v->cssText, "'squow'",
'prim->cssText(...) in non-void cx sets the val if existing val is str'
# ~~~ We also need a test for list sub-values retaining their owner attri-
# bute when they change type
}
use tests 10; # writing cssText on list values
{
my $v = new CSS::DOM::Value::List values => [];
ok !eval{ $v->cssText('aaa'); 1 },
'setting cssText on an unowned css list value object dies';
isa_ok $@,'CSS::DOM::Exception', 'class of error when list->cssText dies';
cmp_ok $@, '==', &CSS::DOM::Exception::NO_MODIFICATION_ALLOWED_ERR,
'and the right type of error, too (after list->cssText dies)';
$v = new CSS::DOM::Value::List values => [], owner => $s;
ok !eval{ $v->cssText('aaa'); 1 },
'setting cssText on a css value list object with no property dies';
isa_ok $@, 'CSS::DOM::Exception',
'class of error after cssText dies (val list with no prop)';
cmp_ok $@, '==', &CSS::DOM::Exception::NO_MODIFICATION_ALLOWED_ERR,
'error code when cssText dies (val list w/no prop)';
$s->fontFamily('ching');
$v = $s->getPropertyCSSValue('font-family');
$v->cssText('breck, chon');
is $s->fontFamily, 'breck, chon',
'setting the cssText of a value list changes the prop';
is $v->cssText, 'breck, chon',
'setting the cssText of a value list changes the cssText thereof';
$v->[0]->cssText('phrext');
is $v->cssText, 'phrext, chon',
'setting the cssText of a list’s sub-value sets the cssText of the list';
my $called;
$s->modification_handler(sub { ++$called });
$s->getPropertyCSSValue('font-family')->cssText('red');
is $called, 1,
'modification_handler is called when a CSS::DOM::Value::List changes';
}
|
