whatpm/t/CSS-Tokenizer.t

#!/usr/bin/perl
use strict;

my $test_dir_name = 't/';
my $dir_name = 't/tokenizer/';

use JSON 1.07;
$JSON::UnMapping = 1;
$JSON::UTF8 = 1;

use Test;
BEGIN { plan tests => 615 }

use Data::Dumper;
$Data::Dumper::Useqq = 1;
sub Data::Dumper::qquote {
  my $s = shift;
  $s =~ s/([^\x20\x21-\x26\x28-\x5B\x5D-\x7E])/sprintf '\x{%02X}', ord $1/ge;
  return q<qq'> . $s . q<'>;
} # Data::Dumper::qquote

use Whatpm::CSS::Tokenizer;

for my $file_name (grep {$_} split /\s+/, qq[
                      ${test_dir_name}css-token-1.test
                     ]) {
  open my $file, '<', $file_name
    or die "$0: $file_name: $!";
  local $/ = undef;
  my $js = <$file>;
  close $file;

  print "# $file_name\n";
  $js =~ s{\\u[Dd]([89A-Fa-f][0-9A-Fa-f][0-9A-Fa-f])
      \\u[Dd]([89A-Fa-f][0-9A-Fa-f][0-9A-Fa-f])}{
    ## NOTE: JSON::Parser does not decode surrogate pair escapes
    ## NOTE: In older version of JSON::Parser, utf8 string will be broken
    ## by parsing.  Use latest version!
    ## NOTE: Encode.pm is broken; it converts e.g. U+10FFFF to U+FFFD.
    my $c = 0x10000;
    $c += ((((hex $1) & 0b1111111111) << 10) | ((hex $2) & 0b1111111111));
    chr $c;
  }gex;
  my $tests = jsonToObj ($js)->{tests};
  TEST: for my $test (@$tests) {
    my $s = $test->{input};

    my $p = Whatpm::CSS::Tokenizer->new;
    
    my $pos = 0;
    my $length = length $s;
    $p->{get_char} = sub {
      if ($pos < $length) {
        return ord substr $s, $pos++, 1;
      } else {
        return -1;
      }
    };
    $p->init;

    my @token;
    while (1) {
      my $token = $p->get_next_token;
      last if $token->{type} == Whatpm::CSS::Tokenizer::EOF_TOKEN ();

      my $test_token;
      $test_token->[0] = $Whatpm::CSS::Tokenizer::TokenName[$token->{type}] ||
          $token->{type};
      if ({
           NUMBER => 1,
           DIMENSION => 1,
           PERCENTAGE => 1,
          }->{$test_token->[0]}) {
        push @$test_token, $token->{number};
        delete $token->{value}
            if defined $token->{value} and $token->{value} eq '';
      }
      unless ({
               DOT => 1,
               LBRACE => 1, RBRACE => 1,
               LBRACKET => 1, RBRACKET => 1,
               CDO => 1, CDC => 1,
               COLON => 1,
               COMMA => 1,
               COMMENT_INVALID => 1,
               DASHMATCH => 1,
               DIMENSION => (not defined $token->{value}),
               EXCLAMATION => 1,
               GREATER => 1,
               INCLUDES => 1,
               MATCH => 1,
               MINUS => 1,
               NUMBER => (not defined $token->{value}),
               LPAREN => 1, RPAREN => 1,
               PERCENTAGE => (not defined $token->{value}),
               PLUS => 1,
               PREFIXMATCH => 1,
               S => 1,
               SEMICOLON => 1,
               STAR => 1,
               SUBSTRINGMATCH => 1,
               SUFFIXMATCH => 1,
               TILDE => 1,
               URI_INVALID => 1,
               URI_PREFIX_INVALID => 1,
               VBAR => 1,
              }->{$test_token->[0]}) {
        push @$test_token, $token->{value};
      }
      push @token, $test_token;
    }
     
    my $expected_dump = Dumper ($test->{output});
    my $parser_dump = Dumper (\@token);
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	wakaba	1.7	BEGIN { plan tests => 615 }
13	wakaba	1.1
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.4	if ({
70			NUMBER => 1,
71			DIMENSION => 1,
72			PERCENTAGE => 1,
73			}->{$test_token->[0]}) {
74	wakaba	1.3	push @$test_token, $token->{number};
75			delete $token->{value}
76			if defined $token->{value} and $token->{value} eq '';
77			}
78	wakaba	1.4	unless ({
79	wakaba	1.6	DOT => 1,
80	wakaba	1.4	LBRACE => 1, RBRACE => 1,
81			LBRACKET => 1, RBRACKET => 1,
82	wakaba	1.5	CDO => 1, CDC => 1,
83	wakaba	1.6	COLON => 1,
84			COMMA => 1,
85	wakaba	1.5	COMMENT_INVALID => 1,
86	wakaba	1.6	DASHMATCH => 1,
87	wakaba	1.4	DIMENSION => (not defined $token->{value}),
88	wakaba	1.6	EXCLAMATION => 1,
89	wakaba	1.4	GREATER => 1,
90	wakaba	1.6	INCLUDES => 1,
91			MATCH => 1,
92			MINUS => 1,
93	wakaba	1.4	NUMBER => (not defined $token->{value}),
94			LPAREN => 1, RPAREN => 1,
95			PERCENTAGE => (not defined $token->{value}),
96			PLUS => 1,
97	wakaba	1.6	PREFIXMATCH => 1,
98	wakaba	1.4	S => 1,
99	wakaba	1.5	SEMICOLON => 1,
100	wakaba	1.6	STAR => 1,
101			SUBSTRINGMATCH => 1,
102			SUFFIXMATCH => 1,
103			TILDE => 1,
104	wakaba	1.4	URI_INVALID => 1,
105			URI_PREFIX_INVALID => 1,
106	wakaba	1.6	VBAR => 1,
107	wakaba	1.4	}->{$test_token->[0]}) {
108			push @$test_token, $token->{value};
109			}
110	wakaba	1.1	push @token, $test_token;
111			}
112
113			my $expected_dump = Dumper ($test->{output});
114			my $parser_dump = Dumper (\@token);
115