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 => 347 }

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 ({
               LBRACE => 1, RBRACE => 1,
               LBRACKET => 1, RBRACKET => 1,
               CDC => 1,
               CDO => 1,
               DIMENSION => (not defined $token->{value}),
               GREATER => 1,
               NUMBER => (not defined $token->{value}),
               LPAREN => 1, RPAREN => 1,
               PERCENTAGE => (not defined $token->{value}),
               PLUS => 1,
               S => 1,
               URI_INVALID => 1,
               URI_PREFIX_INVALID => 1,
              }->{$test_token->[0]}) {
        push @$test_token, $token->{value};
      }
      push @token, $test_token;
    }
     
    my $expected_dump = Dumper ($test->{output});
    my $parser_dump = Dumper (\@token);
    ok $parser_dump, $expected_dump,
        $test->{description} . ': ' . Data::Dumper::qquote ($test->{input});
  }
}

## License: Public Domain.
## $Date: 2007/09/08 13:43:58 $
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	if ({
70	NUMBER => 1,
71	DIMENSION => 1,
72	PERCENTAGE => 1,
73	}->{$test_token->[0]}) {
74	push @$test_token, $token->{number};
75	delete $token->{value}
76	if defined $token->{value} and $token->{value} eq '';
77	}
78	unless ({
79	LBRACE => 1, RBRACE => 1,
80	LBRACKET => 1, RBRACKET => 1,
81	CDC => 1,
82	CDO => 1,
83	DIMENSION => (not defined $token->{value}),
84	GREATER => 1,
85	NUMBER => (not defined $token->{value}),
86	LPAREN => 1, RPAREN => 1,
87	PERCENTAGE => (not defined $token->{value}),
88	PLUS => 1,
89	S => 1,
90	URI_INVALID => 1,
91	URI_PREFIX_INVALID => 1,
92	}->{$test_token->[0]}) {
93	push @$test_token, $token->{value};
94	}
95	push @token, $test_token;
96	}
97
98	my $expected_dump = Dumper ($test->{output});
99	my $parser_dump = Dumper (\@token);
100	ok $parser_dump, $expected_dump,
101	$test->{description} . ': ' . Data::Dumper::qquote ($test->{input});
102	}
103	}
104
105	## License: Public Domain.
106	## $Date: 2007/09/08 13:43:58 $