74 |
#return Whatpm::Charset::UnicodeChecker->new_handle ($_[0], 'html5'); |
#return Whatpm::Charset::UnicodeChecker->new_handle ($_[0], 'html5'); |
75 |
}; # $chk |
}; # $chk |
76 |
|
|
77 |
|
my $p = Whatpm::XML::Parser->new; |
78 |
my $result; |
my $result; |
79 |
unless (defined $test->{element}) { |
unless (defined $test->{element}) { |
80 |
Whatpm::XML::Parser->parse_char_string |
$p->parse_char_string ($test->{data}->[0] => $doc, $onerror, $chk); |
|
($test->{data}->[0] => $doc, $onerror, $chk); |
|
81 |
$result = dumptree ($doc); |
$result = dumptree ($doc); |
82 |
} else { |
} else { |
83 |
## TODO: ... |
## TODO: ... |
88 |
} |
} |
89 |
|
|
90 |
warn "No #errors section ($test->{data}->[0])" unless $test->{errors}; |
warn "No #errors section ($test->{data}->[0])" unless $test->{errors}; |
91 |
|
|
92 |
|
@errors = sort {$a cmp $b} @errors; |
93 |
|
@{$test->{errors}->[0]} = sort {$a cmp $b} @{$test->{errors}->[0] ||= []}; |
94 |
|
|
95 |
ok join ("\n", @errors), join ("\n", @{$test->{errors}->[0] or []}), |
ok join ("\n", @errors), join ("\n", @{$test->{errors}->[0] or []}), |
96 |
'Parse error: ' . Data::Dumper::qquote ($test->{data}->[0]) . '; ' . |
'Parse error: ' . Data::Dumper::qquote ($test->{data}->[0]); |
97 |
join (', ', @errors) . ';' . join (', ', @{$test->{errors}->[0] or []}); |
|
98 |
|
if ($test->{'xml-version'}) { |
99 |
|
ok $doc->xml_version, $test->{'xml-version'}->[0], |
100 |
|
'XML version: ' . Data::Dumper::qquote ($test->{data}->[0]); |
101 |
|
} |
102 |
|
|
103 |
|
if ($test->{'xml-encoding'}) { |
104 |
|
if ($test->{'xml-encoding'}->[1]->[0] eq 'null') { |
105 |
|
ok $doc->xml_encoding, undef, |
106 |
|
'XML encoding: ' . Data::Dumper::qquote ($test->{data}->[0]); |
107 |
|
} else { |
108 |
|
ok $doc->xml_encoding, $test->{'xml-encoding'}->[0], |
109 |
|
'XML encoding: ' . Data::Dumper::qquote ($test->{data}->[0]); |
110 |
|
} |
111 |
|
} |
112 |
|
|
113 |
|
if ($test->{'xml-standalone'}) { |
114 |
|
ok $doc->xml_standalone ? 1 : 0, |
115 |
|
$test->{'xml-standalone'}->[1]->[0] eq 'true' ? 1 : 0, |
116 |
|
'XML standalone: ' . Data::Dumper::qquote ($test->{data}->[0]); |
117 |
|
} |
118 |
|
|
119 |
|
if ($test->{entities}) { |
120 |
|
my @e; |
121 |
|
for (keys %{$p->{ge}}) { |
122 |
|
my $ent = $p->{ge}->{$_}; |
123 |
|
my $v = '<!ENTITY ' . $ent->{name} . ' "'; |
124 |
|
$v .= $ent->{value} if defined $ent->{value}; |
125 |
|
$v .= '" "'; |
126 |
|
$v .= $ent->{pubid} if defined $ent->{pubid}; |
127 |
|
$v .= '" "'; |
128 |
|
$v .= $ent->{sysid} if defined $ent->{sysid}; |
129 |
|
$v .= '" '; |
130 |
|
$v .= $ent->{notation} if defined $ent->{notation}; |
131 |
|
$v .= '>'; |
132 |
|
push @e, $v; |
133 |
|
} |
134 |
|
for (keys %{$p->{pe}}) { |
135 |
|
my $ent = $p->{pe}->{$_}; |
136 |
|
my $v = '<!ENTITY % ' . $ent->{name} . ' "'; |
137 |
|
$v .= $ent->{value} if defined $ent->{value}; |
138 |
|
$v .= '" "'; |
139 |
|
$v .= $ent->{pubid} if defined $ent->{pubid}; |
140 |
|
$v .= '" "'; |
141 |
|
$v .= $ent->{sysid} if defined $ent->{sysid}; |
142 |
|
$v .= '" '; |
143 |
|
$v .= $ent->{notation} if defined $ent->{notation}; |
144 |
|
$v .= '>'; |
145 |
|
push @e, $v; |
146 |
|
} |
147 |
|
ok join ("\x0A", @e), $test->{entities}->[0], |
148 |
|
'Entities: ' . Data::Dumper::qquote ($test->{data}->[0]); |
149 |
|
} |
150 |
|
|
151 |
$test->{document}->[0] .= "\x0A" if length $test->{document}->[0]; |
$test->{document}->[0] .= "\x0A" if length $test->{document}->[0]; |
152 |
ok $result, $test->{document}->[0], |
ok $result, $test->{document}->[0], |
154 |
} # test |
} # test |
155 |
|
|
156 |
my @FILES = grep {$_} split /\s+/, qq[ |
my @FILES = grep {$_} split /\s+/, qq[ |
157 |
${test_dir_name}cdata-1.dat |
${test_dir_name}elements-1.dat |
158 |
${test_dir_name}attrs-1.dat |
${test_dir_name}attrs-1.dat |
159 |
|
${test_dir_name}texts-1.dat |
160 |
|
${test_dir_name}cdata-1.dat |
161 |
|
${test_dir_name}charref-1.dat |
162 |
|
${test_dir_name}comments-2.dat |
163 |
|
${test_dir_name}pis-1.dat |
164 |
|
${test_dir_name}pis-2.dat |
165 |
|
${test_dir_name}xmldecls-1.dat |
166 |
${test_dir_name}tree-1.dat |
${test_dir_name}tree-1.dat |
167 |
|
${test_dir_name}ns-elements-1.dat |
168 |
${test_dir_name}ns-attrs-1.dat |
${test_dir_name}ns-attrs-1.dat |
169 |
|
${test_dir_name}doctypes-1.dat |
170 |
|
${test_dir_name}doctypes-2.dat |
171 |
|
${test_dir_name}eldecls-1.dat |
172 |
|
${test_dir_name}attlists-1.dat |
173 |
|
${test_dir_name}entities-1.dat |
174 |
|
${test_dir_name}entities-2.dat |
175 |
|
${test_dir_name}notations-1.dat |
176 |
|
${test_dir_name}entrefs-1.dat |
177 |
|
${test_dir_name}entrefs-2.dat |
178 |
]; |
]; |
179 |
|
|
180 |
require 't/testfiles.pl'; |
require 't/testfiles.pl'; |
182 |
errors => {is_list => 1}, |
errors => {is_list => 1}, |
183 |
document => {is_prefixed => 1}, |
document => {is_prefixed => 1}, |
184 |
'document-fragment' => {is_prefixed => 1}, |
'document-fragment' => {is_prefixed => 1}, |
185 |
|
entities => {is_prefixed => 1}, |
186 |
}, \&test) for @FILES; |
}, \&test) for @FILES; |
187 |
|
|
188 |
## License: Public Domain. |
## License: Public Domain. |