| 1 |
#!/usr/bin/perl |
| 2 |
use strict; |
| 3 |
|
| 4 |
use Test; |
| 5 |
BEGIN { plan tests => 864 } |
| 6 |
|
| 7 |
my @FILES = qw[ |
| 8 |
t/content-model-1.dat |
| 9 |
t/content-model-2.dat |
| 10 |
t/content-model-3.dat |
| 11 |
]; |
| 12 |
|
| 13 |
require Whatpm::ContentChecker; |
| 14 |
|
| 15 |
## ISSUE: Currently we require manakai XML parser to test arbitrary XML tree. |
| 16 |
use lib qw[/home/wakaba/work/manakai/lib]; |
| 17 |
require Message::DOM::DOMCore; |
| 18 |
require Message::DOM::XMLParser; |
| 19 |
require Whatpm::HTML; |
| 20 |
require Whatpm::NanoDOM; |
| 21 |
|
| 22 |
my $dom = $Message::DOM::DOMImplementationRegistry->get_dom_implementation; |
| 23 |
my $parser = $dom->create_ls_parser (1); |
| 24 |
|
| 25 |
for my $file_name (@FILES) { |
| 26 |
open my $file, '<', $file_name or die "$0: $file_name: $!"; |
| 27 |
|
| 28 |
my $test; |
| 29 |
my $mode = 'data'; |
| 30 |
while (<$file>) { |
| 31 |
s/\x0D\x0A/\x0A/; |
| 32 |
if (/^#data$/) { |
| 33 |
undef $test; |
| 34 |
$test->{data} = ''; |
| 35 |
$mode = 'data'; |
| 36 |
$test->{parse_as} = 'xml'; |
| 37 |
} elsif (/^#data html$/) { |
| 38 |
undef $test; |
| 39 |
$test->{data} = ''; |
| 40 |
$mode = 'data'; |
| 41 |
$test->{parse_as} = 'html'; |
| 42 |
} elsif (/^#errors$/) { |
| 43 |
$test->{errors} = []; |
| 44 |
$mode = 'errors'; |
| 45 |
$test->{data} =~ s/\x0D?\x0A\z//; |
| 46 |
} elsif (defined $test->{errors} and /^$/) { |
| 47 |
test ($test); |
| 48 |
undef $test; |
| 49 |
} else { |
| 50 |
if ($mode eq 'data') { |
| 51 |
$test->{$mode} .= $_; |
| 52 |
} elsif ($mode eq 'errors') { |
| 53 |
tr/\x0D\x0A//d; |
| 54 |
push @{$test->{errors}}, $_; |
| 55 |
} |
| 56 |
} |
| 57 |
} |
| 58 |
} # @FILES |
| 59 |
|
| 60 |
sub test ($) { |
| 61 |
my $test = shift; |
| 62 |
|
| 63 |
my $doc; |
| 64 |
if ($test->{parse_as} eq 'xml') { |
| 65 |
$doc = $parser->parse ({string_data => $test->{data}}); |
| 66 |
## NOTE: There should be no well-formedness error; if there is, |
| 67 |
## then it is an error of the test case itself. |
| 68 |
} else { |
| 69 |
$doc = Whatpm::NanoDOM::Document->new; |
| 70 |
Whatpm::HTML->parse_string ($test->{data} => $doc); |
| 71 |
} |
| 72 |
|
| 73 |
my @error; |
| 74 |
my $cc = Whatpm::ContentChecker->new; |
| 75 |
$cc->check_element |
| 76 |
($doc->document_element, sub { |
| 77 |
my %opt = @_; |
| 78 |
push @error, get_node_path ($opt{node}) . ';' . $opt{type}; |
| 79 |
}); |
| 80 |
|
| 81 |
ok join ("\n", sort {$a cmp $b} @error), |
| 82 |
join ("\n", sort {$a cmp $b} @{$test->{errors}}), $test->{data}; |
| 83 |
} # test |
| 84 |
|
| 85 |
sub get_node_path ($) { |
| 86 |
my $node = shift; |
| 87 |
my @r; |
| 88 |
while (defined $node) { |
| 89 |
my $rs; |
| 90 |
if ($node->node_type == 1) { |
| 91 |
$rs = $node->manakai_local_name; |
| 92 |
$node = $node->parent_node; |
| 93 |
} elsif ($node->node_type == 2) { |
| 94 |
$rs = '@' . $node->manakai_local_name; |
| 95 |
$node = $node->owner_element; |
| 96 |
} elsif ($node->node_type == 3) { |
| 97 |
$rs = '"' . $node->data . '"'; |
| 98 |
$node = $node->parent_node; |
| 99 |
} elsif ($node->node_type == 9) { |
| 100 |
$rs = ''; |
| 101 |
$node = $node->parent_node; |
| 102 |
} else { |
| 103 |
$rs = '#' . $node->node_type; |
| 104 |
$node = $node->parent_node; |
| 105 |
} |
| 106 |
unshift @r, $rs; |
| 107 |
} |
| 108 |
return join '/', @r; |
| 109 |
} # get_node_path |
| 110 |
|
| 111 |
## License: Public Domain. |
| 112 |
## $Date: 2007/05/26 12:33:04 $ |
Parent Directory
| 
Revision Log