| 1 |
wakaba |
1.1 |
#!/usr/bin/perl |
| 2 |
|
|
use strict; |
| 3 |
|
|
|
| 4 |
|
|
my $test_dir_name = 't/'; |
| 5 |
|
|
my $dir_name = 't/tokenizer/'; |
| 6 |
|
|
|
| 7 |
|
|
use JSON 1.07; |
| 8 |
|
|
$JSON::UnMapping = 1; |
| 9 |
|
|
$JSON::UTF8 = 1; |
| 10 |
|
|
|
| 11 |
|
|
use Test; |
| 12 |
|
|
BEGIN { plan tests => 347 } |
| 13 |
|
|
|
| 14 |
|
|
use Data::Dumper; |
| 15 |
|
|
$Data::Dumper::Useqq = 1; |
| 16 |
|
|
sub Data::Dumper::qquote { |
| 17 |
|
|
my $s = shift; |
| 18 |
|
|
$s =~ s/([^\x20\x21-\x26\x28-\x5B\x5D-\x7E])/sprintf '\x{%02X}', ord $1/ge; |
| 19 |
|
|
return q<qq'> . $s . q<'>; |
| 20 |
|
|
} # Data::Dumper::qquote |
| 21 |
|
|
|
| 22 |
|
|
use Whatpm::CSS::Tokenizer; |
| 23 |
|
|
|
| 24 |
|
|
for my $file_name (grep {$_} split /\s+/, qq[ |
| 25 |
|
|
${test_dir_name}css-token-1.test |
| 26 |
|
|
]) { |
| 27 |
|
|
open my $file, '<', $file_name |
| 28 |
|
|
or die "$0: $file_name: $!"; |
| 29 |
|
|
local $/ = undef; |
| 30 |
|
|
my $js = <$file>; |
| 31 |
|
|
close $file; |
| 32 |
|
|
|
| 33 |
|
|
print "# $file_name\n"; |
| 34 |
|
|
$js =~ s{\\u[Dd]([89A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]) |
| 35 |
|
|
\\u[Dd]([89A-Fa-f][0-9A-Fa-f][0-9A-Fa-f])}{ |
| 36 |
|
|
## NOTE: JSON::Parser does not decode surrogate pair escapes |
| 37 |
|
|
## NOTE: In older version of JSON::Parser, utf8 string will be broken |
| 38 |
|
|
## by parsing. Use latest version! |
| 39 |
|
|
## NOTE: Encode.pm is broken; it converts e.g. U+10FFFF to U+FFFD. |
| 40 |
|
|
my $c = 0x10000; |
| 41 |
|
|
$c += ((((hex $1) & 0b1111111111) << 10) | ((hex $2) & 0b1111111111)); |
| 42 |
|
|
chr $c; |
| 43 |
|
|
}gex; |
| 44 |
|
|
my $tests = jsonToObj ($js)->{tests}; |
| 45 |
|
|
TEST: for my $test (@$tests) { |
| 46 |
|
|
my $s = $test->{input}; |
| 47 |
|
|
|
| 48 |
|
|
my $p = Whatpm::CSS::Tokenizer->new; |
| 49 |
|
|
|
| 50 |
|
|
my $pos = 0; |
| 51 |
|
|
my $length = length $s; |
| 52 |
|
|
$p->{get_char} = sub { |
| 53 |
|
|
if ($pos < $length) { |
| 54 |
|
|
return ord substr $s, $pos++, 1; |
| 55 |
|
|
} else { |
| 56 |
|
|
return -1; |
| 57 |
|
|
} |
| 58 |
|
|
}; |
| 59 |
|
|
$p->init; |
| 60 |
|
|
|
| 61 |
|
|
my @token; |
| 62 |
|
|
while (1) { |
| 63 |
|
|
my $token = $p->get_next_token; |
| 64 |
|
|
last if $token->{type} == Whatpm::CSS::Tokenizer::EOF_TOKEN (); |
| 65 |
|
|
|
| 66 |
|
|
my $test_token; |
| 67 |
|
|
$test_token->[0] = $Whatpm::CSS::Tokenizer::TokenName[$token->{type}] || |
| 68 |
|
|
$token->{type}; |
| 69 |
wakaba |
1.3 |
if ($test_token->[0] eq 'NUMBER' or $test_token->[0] eq 'DIMENSION') { |
| 70 |
|
|
push @$test_token, $token->{number}; |
| 71 |
|
|
delete $token->{value} |
| 72 |
|
|
if defined $token->{value} and $token->{value} eq ''; |
| 73 |
|
|
} |
| 74 |
|
|
push @$test_token, $token->{value} if defined $token->{value}; |
| 75 |
wakaba |
1.1 |
push @token, $test_token; |
| 76 |
|
|
} |
| 77 |
|
|
|
| 78 |
|
|
my $expected_dump = Dumper ($test->{output}); |
| 79 |
|
|
my $parser_dump = Dumper (\@token); |
| 80 |
|
|
ok $parser_dump, $expected_dump, |
| 81 |
|
|
$test->{description} . ': ' . Data::Dumper::qquote ($test->{input}); |
| 82 |
|
|
} |
| 83 |
|
|
} |
| 84 |
|
|
|
| 85 |
|
|
## License: Public Domain. |
| 86 |
wakaba |
1.3 |
## $Date: 2007/09/08 10:21:04 $ |
Parent Directory
| 
Revision Log