| 1 |
#!/usr/bin/perl |
#!/usr/bin/perl |
| 2 |
use strict; |
use strict; |
| 3 |
|
|
| 4 |
|
my $DEBUG = $ENV{DEBUG}; |
| 5 |
|
|
| 6 |
my $dir_name; |
my $dir_name; |
| 7 |
my $test_dir_name; |
my $test_dir_name; |
| 8 |
BEGIN { |
BEGIN { |
| 26 |
} |
} |
| 27 |
|
|
| 28 |
use Test; |
use Test; |
| 29 |
BEGIN { plan tests => 396 } |
BEGIN { plan tests => 477 } |
| 30 |
|
|
| 31 |
use Data::Dumper; |
use Data::Dumper; |
| 32 |
$Data::Dumper::Useqq = 1; |
$Data::Dumper::Useqq = 1; |
| 36 |
return q<qq'> . $s . q<'>; |
return q<qq'> . $s . q<'>; |
| 37 |
} # Data::Dumper::qquote |
} # Data::Dumper::qquote |
| 38 |
|
|
| 39 |
|
if ($DEBUG) { |
| 40 |
|
my $not_found = {%{$Whatpm::HTML::Debug::cp or {}}}; |
| 41 |
|
|
| 42 |
|
$Whatpm::HTML::Debug::cp_pass = sub { |
| 43 |
|
my $id = shift; |
| 44 |
|
delete $not_found->{$id}; |
| 45 |
|
}; |
| 46 |
|
|
| 47 |
|
END { |
| 48 |
|
for my $id (sort {$a <=> $b || $a cmp $b} grep {!/^[ti]/} |
| 49 |
|
keys %$not_found) { |
| 50 |
|
print "# checkpoint $id is not reached\n"; |
| 51 |
|
} |
| 52 |
|
} |
| 53 |
|
} |
| 54 |
|
|
| 55 |
use Whatpm::HTML; |
use Whatpm::HTML; |
| 56 |
|
|
| 57 |
for my $file_name (grep {$_} split /\s+/, qq[ |
for my $file_name (grep {$_} split /\s+/, qq[ |
| 61 |
${dir_name}test4.test |
${dir_name}test4.test |
| 62 |
${dir_name}contentModelFlags.test |
${dir_name}contentModelFlags.test |
| 63 |
${dir_name}escapeFlag.test |
${dir_name}escapeFlag.test |
| 64 |
|
${dir_name}entities.test |
| 65 |
|
${dir_name}xmlViolation.test |
| 66 |
${test_dir_name}tokenizer-test-1.test |
${test_dir_name}tokenizer-test-1.test |
| 67 |
]) { |
]) { |
| 68 |
open my $file, '<', $file_name |
open my $file, '<', $file_name |
| 82 |
$c += ((((hex $1) & 0b1111111111) << 10) | ((hex $2) & 0b1111111111)); |
$c += ((((hex $1) & 0b1111111111) << 10) | ((hex $2) & 0b1111111111)); |
| 83 |
chr $c; |
chr $c; |
| 84 |
}gex; |
}gex; |
| 85 |
my $tests = jsonToObj ($js)->{tests}; |
my $json = jsonToObj ($js); |
| 86 |
|
my $tests = $json->{tests} || $json->{xmlViolationTests}; |
| 87 |
TEST: for my $test (@$tests) { |
TEST: for my $test (@$tests) { |
| 88 |
my $s = $test->{input}; |
my $s = $test->{input}; |
| 89 |
|
|
| 106 |
my $p = Whatpm::HTML->new; |
my $p = Whatpm::HTML->new; |
| 107 |
my $i = 0; |
my $i = 0; |
| 108 |
my @token; |
my @token; |
| 109 |
$p->{set_next_input_character} = sub { |
$p->{set_next_char} = sub { |
| 110 |
my $self = shift; |
my $self = shift; |
| 111 |
|
|
| 112 |
pop @{$self->{prev_input_character}}; |
pop @{$self->{prev_char}}; |
| 113 |
unshift @{$self->{prev_input_character}}, $self->{next_input_character}; |
unshift @{$self->{prev_char}}, $self->{next_char}; |
| 114 |
|
|
| 115 |
$self->{next_input_character} = -1 and return if $i >= length $s; |
$self->{next_char} = -1 and return if $i >= length $s; |
| 116 |
$self->{next_input_character} = ord substr $s, $i++, 1; |
$self->{next_char} = ord substr $s, $i++, 1; |
| 117 |
|
|
| 118 |
if ($self->{next_input_character} == 0x000D) { # CR |
if ($self->{next_char} == 0x000D) { # CR |
| 119 |
$i++ if substr ($s, $i, 1) eq "\x0A"; |
$i++ if substr ($s, $i, 1) eq "\x0A"; |
| 120 |
$self->{next_input_character} = 0x000A; # LF # MUST |
$self->{next_char} = 0x000A; # LF # MUST |
| 121 |
} elsif ($self->{next_input_character} > 0x10FFFF) { |
} elsif ($self->{next_char} > 0x10FFFF) { |
| 122 |
$self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST |
$self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST |
| 123 |
push @token, 'ParseError'; |
push @token, 'ParseError'; |
| 124 |
} elsif ($self->{next_input_character} == 0x0000) { # NULL |
} elsif ($self->{next_char} == 0x0000) { # NULL |
| 125 |
$self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST |
$self->{next_char} = 0xFFFD; # REPLACEMENT CHARACTER # MUST |
| 126 |
push @token, 'ParseError'; |
push @token, 'ParseError'; |
| 127 |
} |
} |
| 128 |
}; |
}; |
| 129 |
$p->{prev_input_character} = [-1, -1, -1]; |
$p->{prev_char} = [-1, -1, -1]; |
| 130 |
$p->{next_input_character} = -1; |
$p->{next_char} = -1; |
| 131 |
|
|
| 132 |
$p->{parse_error} = sub { |
$p->{parse_error} = sub { |
| 133 |
push @token, 'ParseError'; |
push @token, 'ParseError'; |
| 159 |
$test_token->[1] = $token->{data} if defined $token->{data}; |
$test_token->[1] = $token->{data} if defined $token->{data}; |
| 160 |
if ($token->{type} == Whatpm::HTML::START_TAG_TOKEN ()) { |
if ($token->{type} == Whatpm::HTML::START_TAG_TOKEN ()) { |
| 161 |
$test_token->[2] = {map {$_->{name} => $_->{value}} values %{$token->{attributes}}}; |
$test_token->[2] = {map {$_->{name} => $_->{value}} values %{$token->{attributes}}}; |
| 162 |
|
if ({ |
| 163 |
|
## NOTE: Permitted slash |
| 164 |
|
br => 1, link => 1, |
| 165 |
|
}->{$token->{tag_name}}) { |
| 166 |
|
delete $p->{self_closing}; |
| 167 |
|
} |
| 168 |
} elsif ($token->{type} == Whatpm::HTML::DOCTYPE_TOKEN ()) { |
} elsif ($token->{type} == Whatpm::HTML::DOCTYPE_TOKEN ()) { |
| 169 |
$test_token->[1] = $token->{name}; |
$test_token->[1] = $token->{name}; |
| 170 |
$test_token->[2] = $token->{public_identifier}; |
$test_token->[2] = $token->{public_identifier}; |
| 171 |
$test_token->[3] = $token->{system_identifier}; |
$test_token->[3] = $token->{system_identifier}; |
| 172 |
$test_token->[4] = $token->{correct} ? 1 : 0; |
$test_token->[4] = $token->{quirks} ? 0 : 1; |
| 173 |
} |
} |
| 174 |
|
|
| 175 |
if (@token and ref $token[-1] and $token[-1]->[0] eq 'Character' and |
if (@token and ref $token[-1] and $token[-1]->[0] eq 'Character' and |