1## skip Test::Tabs 2use Test::More; 3use HTML::HTML5::Parser; 4 5BEGIN { 6 eval { require Moo; 1 } or plan skip_all => 'Need Moo!' 7}; 8 9{ 10 package XML::LibXML::Document; 11 sub pythonDebug 12 { 13 my $self = shift; 14 my ($indent, $parser) = @_; 15 $indent = '' unless defined $indent; 16 17 my $return; 18 19 my $element = $parser->dtd_element($self); 20 my $public = $parser->dtd_public_id($self) || ''; 21 my $system = $parser->dtd_system_id($self) || ''; 22 23 if (defined $element) 24 { 25 $return = sprintf( 26 "| <!DOCTYPE %s%s%s>\n", 27 $element, 28 (($public||$system) ? " \"$public\"" : ""), 29 (($public||$system) ? " \"$system\"" : ""), 30 ); 31 } 32 33 $return .= $_->pythonDebug(q{| }, $parser) foreach $self->childNodes; 34 return $return; 35 } 36} 37 38{ 39 package XML::LibXML::DocumentFragment; 40 sub pythonDebug 41 { 42 my $self = shift; 43 my ($indent, $parser) = @_; 44 $indent = '' unless defined $indent; 45 46 $self->normalize; 47 48 my $return; 49 foreach ($self->childNodes) 50 { 51 $return .= $_->pythonDebug($indent . q{| }, $parser); 52 } 53 return $return; 54 } 55} 56 57{ 58 package XML::LibXML::Element; 59 sub pythonDebug 60 { 61 my $self = shift; 62 my ($indent, $parser) = @_; 63 $indent = '' unless defined $indent; 64 65 $self->normalize; 66 67 my $nsbit = ''; 68 $nsbit = 'svg ' if $self->namespaceURI =~ /svg/i; 69 $nsbit = 'math ' if $self->namespaceURI =~ /math/i; 70 my $return = sprintf("%s<%s%s>\n", $indent, $nsbit, $self->localname); 71 72 my @attribs = 73 sort { $a->localname cmp $b->localname } 74 grep { not $_->isa('XML::LibXML::Namespace') } 75 $self->attributes; 76 foreach (@attribs) 77 { 78 $return .= $_->pythonDebug($indent . q{ }, $parser); 79 } 80 81 if ($self->localname eq 'noscript') 82 { 83 my $innerHTML = join q{}, map { $_->toString } $self->childNodes; 84 $return .= $indent . q{ "} . $innerHTML . "\"\n"; 85 } 86 else 87 { 88 foreach ($self->childNodes) 89 { 90 $return .= $_->pythonDebug($indent . q{ }, $parser); 91 } 92 } 93 94 return $return; 95 } 96} 97 98{ 99 package XML::LibXML::Text; 100 sub pythonDebug 101 { 102 my $self = shift; 103 my ($indent, $parser) = @_; 104 $indent = '' unless defined $indent; 105 106 return sprintf("%s\"%s\"\n", $indent, $self->data); 107 } 108} 109 110{ 111 package XML::LibXML::Comment; 112 sub pythonDebug 113 { 114 my $self = shift; 115 my ($indent, $parser) = @_; 116 $indent = '' unless defined $indent; 117 118 return sprintf("%s<!-- %s -->\n", $indent, $self->data); 119 } 120} 121 122{ 123 package XML::LibXML::Attr; 124 sub pythonDebug 125 { 126 my $self = shift; 127 my ($indent, $parser) = @_; 128 $indent = '' unless defined $indent; 129 130 return sprintf("%s%s %s=\"%s\"\n", $indent, split(/:/, $self->nodeName), $self->value) 131 if $self->namespaceURI && $self->nodeName=~/:/; 132 return sprintf("%s%s=\"%s\"\n", $indent, $self->localname, $self->value); 133 } 134} 135 136{ 137 package Local::HTML5Lib::Test; 138 139 use Moo; 140 141 has test_file => (is => 'rw'); 142 has test_number => (is => 'rw'); 143 has data => (is => 'rw'); 144 has errors => (is => 'rw'); 145 has document => (is => 'rw'); 146 has document_fragment => (is => 'rw'); 147 has parser => (is => 'lazy', builder => '_build_parser'); 148 149 sub test_id 150 { 151 my $self = shift; 152 if ($self->test_file->filename =~ m{ / ([^/]+) $ }x) 153 { 154 sprintf('%s:%s', $1, $self->test_number||1); 155 } 156 } 157 158 sub dom 159 { 160 my ($self) = @_; 161 162 if ($self->document_fragment) 163 { 164 return $self->parser->parse_balanced_chunk( 165 $self->data, 166 {within => $self->document_fragment}, 167 ); 168 } 169 170 return eval { 171 $self->parser->parse_string($self->data); 172 } || do { 173 my $e = $@; 174 my $xml = 'XML::LibXML::Document'->new('1.0', 'utf-8'); 175 $xml->setDocumentElement( $xml->createElementNS('http://www.w3.org/1999/xhtml', 'html') ); 176 $xml->documentElement->appendText("ERROR: $e"); 177 $xml; 178 } 179 } 180 181 sub _build_parser 182 { 183 require HTML::HTML5::Parser; 184 'HTML::HTML5::Parser'->new; 185 } 186 187 sub __uniscape 188 { 189 my $str = shift; 190 eval { 191 $str =~ s{ ([^\n\x20-\x7E]) }{ sprintf('\x{%04X}', ord($1)) }gex; 192 }; 193 $str; 194 } 195 196 sub run 197 { 198 my ($self) = @_; 199 my $expected = $self->document."\n"; 200 my $got = $self->dom->pythonDebug(undef, $self->parser); 201 utf8::decode($got); 202 203 local $Test::Builder::Level = $Test::Builder::Level + 1; 204 205 SKIP: { 206 my $excuse = $::SKIP->{ $self->test_id }; 207 Test::More::skip($excuse, 1) if defined $excuse; 208 209 if ($got eq $expected) 210 { 211 Test::More::pass("DATA: ".$self->data); 212 return 1; 213 } 214 else 215 { 216 Test::More::fail("DATA: ".$self->data); 217 Test::More::diag("ID: ".$self->test_id); 218 Test::More::diag("GOT:\n" . __uniscape $got); 219 Test::More::diag("EXPECTED:\n" . __uniscape $expected); 220 return 0; 221 } 222 } 223 } 224} 225 226{ 227 package Local::HTML5Lib::TestFile; 228 229 use Moo; 230 231 has filename => (is => "rw"); 232 has tests => (is => "rw"); 233 has last_score => (is => "rw"); 234 235 sub read_file 236 { 237 my ($class, $filename) = @_; 238 239 my $self = $class->new( 240 filename => $filename, 241 ); 242 243 my @tests; 244 245 open my $fh, '<', $filename; 246 push @tests, (my $current_test = { test_file=>$self }); 247 my $current_key; 248 my @lines = <$fh>; # sometimes we need to peek at the next line; 249 while (defined ($_ = shift @lines)) 250 { 251 no warnings; 252 253 if (!/\S/ and (!defined $lines[0] or $lines[0]=~ /^\#data/)) 254 { 255 $current_test->{test_number} = @tests; 256 chomp $current_test->{$current_key} if defined $current_key; 257 $current_test = { test_file=>$self }; 258 $current_key = undef; 259 push @tests, $current_test; 260 next; 261 } 262 263 if (/^\#(.+)/) 264 { 265 chomp $current_test->{$current_key} if defined $current_key; 266 ($current_key = $1) =~ s/-/_/g; 267 next; 268 } 269 270 $current_test->{$current_key} .= $_; 271 } 272 273 chomp $current_test->{$current_key}; 274 275 $self->tests([ map { 276 utf8::decode($_->{document}); 277 utf8::decode($_->{data}); 278 Local::HTML5Lib::Test->new(%$_); 279 } @tests]); 280 return $self; 281 } 282 283 sub run 284 { 285 local $Test::Builder::Level = $Test::Builder::Level + 1; 286 287 my $self = shift; 288 $self->{last_score} = 0; 289 Test::More::subtest( 290 sprintf("Test file: %s", $self->filename), 291 sub { $self->{last_score} += ($_->run ? 1 : 0) for @{ $self->tests } }, 292 ); 293 } 294} 295 296package main; 297 298our $SKIP = { 299 'tests26.dat:10' 300 => 'requires HTML parser to construct a DOM tree which is illegal in libxml (bad attribute name)', 301 'webkit01.dat:14' 302 => 'requires HTML parser to construct a DOM tree which is illegal in libxml (bad element name)', 303 'webkit01.dat:42' 304 => 'requires HTML parser to construct a DOM tree which is illegal in libxml (bad attribute name)', 305 'webkit02.dat:4' 306 => 'I basically just disagree with this test.', 307 'html5test-com.dat:1' 308 => 'requires HTML parser to construct a DOM tree which is illegal in libxml (bad element name)', 309 'html5test-com.dat:2' 310 => 'requires HTML parser to construct a DOM tree which is illegal in libxml (bad attribute name)', 311 'html5test-com.dat:4' 312 => 'requires HTML parser to construct a DOM tree which is illegal in libxml (bad attribute name)', 313 }; 314 315my @fails; 316my @passes; 317 318unless (@ARGV) 319{ 320 @ARGV = <t/html5lib-pass/*.dat>; 321} 322 323plan tests => scalar(@ARGV); 324 325while (my $f = shift) 326{ 327 my $F = Local::HTML5Lib::TestFile->read_file($f); 328 if ($F->run) 329 { 330 push @passes, $F; 331 } 332 else 333 { 334 push @fails, $F; 335 } 336} 337 338if (@fails) 339{ 340 diag "FAILED:"; 341 diag sprintf(" %s [%d/%d]", $_->filename, $_->last_score, scalar(@{$_->tests})) 342 for @fails; 343} 344 345if (@passes) 346{ 347 diag "PASSED:"; 348 diag sprintf(" %s [%d/%d]", $_->filename, $_->last_score, scalar(@{$_->tests})) 349 for @passes; 350} 351 352=head1 PURPOSE 353 354Tests from html5lib's testdata/tree-construction. 355 356=head1 SEE ALSO 357 358L<http://code.google.com/p/html5lib/source/browse/testdata/tree-construction>. 359 360=head1 AUTHOR 361 362Toby Inkster, E<lt>tobyink@cpan.orgE<gt> 363 364=head1 COPYRIGHT AND LICENCE 365 366Copyright (C) 2012 by Toby Inkster 367 368This library is free software; you can redistribute it and/or modify 369it under the same terms as Perl itself. 370