/[suikacvs]/markup/html/whatpm/t/HTML-tokenizer.t
Suika

Contents of /markup/html/whatpm/t/HTML-tokenizer.t

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (hide annotations) (download) (as text)
Sat Jun 23 02:26:51 2007 UTC (18 years ago) by wakaba
Branch: MAIN
Changes since 1.7: +2 -1 lines
File MIME type: application/x-troff
++ whatpm/t/ChangeLog	23 Jun 2007 02:21:24 -0000
2007-06-23  Wakaba  <wakaba@suika.fam.cx>

	* Makefile, HTML-tokenizer.t, HTML-tree.t: New test
	files are added.

	* tokenize/, tree-construction/: Sync with latest html5lib
	trunk.

1 wakaba 1.1 #!/usr/bin/perl
2     use strict;
3    
4 wakaba 1.2 my $dir_name;
5 wakaba 1.4 my $test_dir_name;
6 wakaba 1.1 BEGIN {
7 wakaba 1.4 $test_dir_name = 't/';
8 wakaba 1.2 $dir_name = 't/tokenizer/';
9 wakaba 1.1 my $skip = "You don't have JSON module";
10     eval q{
11     use JSON 1.00;
12     $skip = "You don't have make command";
13 wakaba 1.3 system ("cd $test_dir_name; make tokenizer-files") == 0 or die
14 wakaba 1.2 unless -f $dir_name.'test1.test';
15 wakaba 1.1 $skip = '';
16     };
17     if ($skip) {
18     print "1..1\n";
19     print "ok 1 # $skip\n";
20     exit;
21     }
22     $JSON::UnMapping = 1;
23 wakaba 1.2 $JSON::UTF8 = 1;
24 wakaba 1.1 }
25    
26     use Test;
27 wakaba 1.7 BEGIN { plan tests => 94 }
28 wakaba 1.2
29 wakaba 1.1 use Data::Dumper;
30 wakaba 1.2 $Data::Dumper::Useqq = 1;
31     sub Data::Dumper::qquote {
32     my $s = shift;
33     $s =~ s/([^\x20\x21-\x26\x28-\x5B\x5D-\x7E])/sprintf '\x{%02X}', ord $1/ge;
34     return q<qq'> . $s . q<'>;
35     } # Data::Dumper::qquote
36 wakaba 1.1
37 wakaba 1.5 use Whatpm::HTML;
38 wakaba 1.1
39 wakaba 1.4 for my $file_name (grep {$_} split /\s+/, qq[
40     ${dir_name}test1.test
41     ${dir_name}test2.test
42     ${dir_name}contentModelFlags.test
43 wakaba 1.8 ${dir_name}escapeFlag.test
44 wakaba 1.4 ${test_dir_name}tokenizer-test-1.test
45 wakaba 1.1 ]) {
46 wakaba 1.4 open my $file, '<', $file_name
47     or die "$0: $file_name: $!";
48 wakaba 1.1 local $/ = undef;
49     my $js = <$file>;
50     close $file;
51    
52     my $tests = jsonToObj ($js)->{tests};
53     TEST: for my $test (@$tests) {
54     my $s = $test->{input};
55    
56     my $j = 1;
57     while ($j < @{$test->{output}}) {
58     if (ref $test->{output}->[$j - 1] and
59     $test->{output}->[$j - 1]->[0] eq 'Character' and
60     ref $test->{output}->[$j] and
61     $test->{output}->[$j]->[0] eq 'Character') {
62     $test->{output}->[$j - 1]->[1]
63     .= $test->{output}->[$j]->[1];
64     splice @{$test->{output}}, $j, 1;
65     }
66     $j++;
67     }
68    
69 wakaba 1.2 my @cm = @{$test->{contentModelFlags} || ['PCDATA']};
70     my $last_start_tag = $test->{lastStartTag};
71 wakaba 1.1 for my $cm (@cm) {
72 wakaba 1.5 my $p = Whatpm::HTML->new;
73 wakaba 1.1 my $i = 0;
74     $p->{set_next_input_character} = sub {
75     my $self = shift;
76     $self->{next_input_character} = -1 and return if $i >= length $s;
77     $self->{next_input_character} = ord substr $s, $i++, 1;
78 wakaba 1.2
79     if ($self->{next_input_character} == 0x000D) { # CR
80     if ($i >= length $s) {
81     #
82     } else {
83     my $next_char = ord substr $s, $i++, 1;
84     if ($next_char == 0x000A) { # LF
85     #
86     } else {
87     push @{$self->{char}}, $next_char;
88     }
89     }
90     $self->{next_input_character} = 0x000A; # LF # MUST
91     } elsif ($self->{next_input_character} > 0x10FFFF) {
92     $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
93     } elsif ($self->{next_input_character} == 0x0000) { # NULL
94     $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
95     }
96 wakaba 1.1 };
97    
98     my @token;
99     $p->{parse_error} = sub {
100     push @token, 'ParseError';
101     };
102    
103     $p->_initialize_tokenizer;
104     $p->{content_model_flag} = $cm;
105 wakaba 1.2 $p->{last_emitted_start_tag_name} = $last_start_tag;
106 wakaba 1.1
107     while (1) {
108     my $token = $p->_get_next_token;
109     last if $token->{type} eq 'end-of-file';
110    
111     my $test_token = [
112     {
113     DOCTYPE => 'DOCTYPE',
114     'start tag' => 'StartTag',
115     'end tag' => 'EndTag',
116     comment => 'Comment',
117     character => 'Character',
118     }->{$token->{type}} || $token->{type},
119     ];
120     $test_token->[1] = $token->{name} if defined $token->{name};
121     $test_token->[1] = $token->{tag_name} if defined $token->{tag_name};
122     $test_token->[1] = $token->{data} if defined $token->{data};
123     $test_token->[2] = $token->{error} ? 1 : 0 if $token->{type} eq 'DOCTYPE';
124     $test_token->[2] = {map {$_->{name} => $_->{value}} values %{$token->{attributes}}}
125     if $token->{type} eq 'start tag';
126    
127     if (@token and ref $token[-1] and $token[-1]->[0] eq 'Character' and
128     $test_token->[0] eq 'Character') {
129     $token[-1]->[1] .= $test_token->[1];
130     } else {
131     push @token, $test_token;
132     }
133     }
134    
135     my $expected_dump = Dumper ($test->{output});
136     my $parser_dump = Dumper (\@token);
137 wakaba 1.2 ok $parser_dump, $expected_dump,
138     $test->{description} . ': ' . $test->{input};
139 wakaba 1.1 }
140     }
141     }
142    
143 wakaba 1.8 ## $Date: 2007/05/20 11:12:25 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24