368 lines
8.0 KiB
Perl
368 lines
8.0 KiB
Perl
#!/usr/bin/perl
|
|
|
|
# This code used to generate a memory error in valgrind/etc.
|
|
# Testing it.
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Test::More;
|
|
|
|
use utf8;
|
|
|
|
use XML::LibXML;
|
|
|
|
BEGIN {
|
|
if (!XML::LibXML::HAVE_READER()) {
|
|
plan skip_all => 'Reader not supported in this libxml2 build';
|
|
exit;
|
|
}
|
|
else {
|
|
plan tests => 2;
|
|
}
|
|
}
|
|
|
|
package Test::XML::Ordered;
|
|
|
|
use XML::LibXML::Reader;
|
|
|
|
use Test::More;
|
|
|
|
use parent 'Exporter';
|
|
|
|
use vars '@EXPORT_OK';
|
|
|
|
@EXPORT_OK = (qw(is_xml_ordered));
|
|
|
|
sub new
|
|
{
|
|
my $class = shift;
|
|
my $self = {};
|
|
|
|
bless $self, $class;
|
|
|
|
$self->_init(@_);
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub _got
|
|
{
|
|
return shift->{got_reader};
|
|
}
|
|
|
|
sub _expected
|
|
{
|
|
return shift->{expected_reader};
|
|
}
|
|
|
|
sub _init
|
|
{
|
|
my ($self, $args) = @_;
|
|
|
|
$self->{got_reader} =
|
|
XML::LibXML::Reader->new(@{$args->{got_params}});
|
|
$self->{expected_reader} =
|
|
XML::LibXML::Reader->new(@{$args->{expected_params}});
|
|
|
|
$self->{diag_message} = $args->{diag_message};
|
|
|
|
$self->{got_end} = 0;
|
|
$self->{expected_end} = 0;
|
|
|
|
return;
|
|
}
|
|
|
|
sub _got_end
|
|
{
|
|
return shift->{got_end};
|
|
}
|
|
|
|
sub _expected_end
|
|
{
|
|
return shift->{expected_end};
|
|
}
|
|
|
|
sub _read_got
|
|
{
|
|
my $self = shift;
|
|
|
|
if ($self->_got->read() <= 0)
|
|
{
|
|
$self->{got_end} = 1;
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
sub _read_expected
|
|
{
|
|
my $self = shift;
|
|
|
|
if ($self->_expected->read() <= 0)
|
|
{
|
|
$self->{expected_end} = 1;
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
sub _next_elem
|
|
{
|
|
my $self = shift;
|
|
|
|
$self->_read_got();
|
|
$self->_read_expected();
|
|
|
|
return;
|
|
}
|
|
|
|
sub _ns
|
|
{
|
|
my $elem = shift;
|
|
my $ns = $elem->namespaceURI();
|
|
|
|
return defined($ns) ? $ns : "";
|
|
}
|
|
|
|
sub _compare_loop
|
|
{
|
|
my $self = shift;
|
|
|
|
my $calc_prob = sub {
|
|
my $args = shift;
|
|
|
|
if (!exists($args->{param}))
|
|
{
|
|
die "No 'param' specified.";
|
|
}
|
|
return
|
|
{
|
|
verdict => 0,
|
|
param => $args->{param},
|
|
}
|
|
};
|
|
|
|
NODE_LOOP:
|
|
while ((!$self->_got_end()) && (!$self->_expected_end()))
|
|
{
|
|
my $type = $self->_got->nodeType();
|
|
my $exp_type = $self->_expected->nodeType();
|
|
|
|
if ($type == XML_READER_TYPE_SIGNIFICANT_WHITESPACE())
|
|
{
|
|
$self->_read_got();
|
|
redo NODE_LOOP;
|
|
}
|
|
elsif ($exp_type == XML_READER_TYPE_SIGNIFICANT_WHITESPACE())
|
|
{
|
|
$self->_read_expected();
|
|
redo NODE_LOOP;
|
|
}
|
|
elsif ($type != $exp_type)
|
|
{
|
|
return $calc_prob->({param => "nodeType"});
|
|
}
|
|
elsif ($type == XML_READER_TYPE_TEXT())
|
|
{
|
|
my $got_text = $self->_got->value();
|
|
my $expected_text = $self->_expected->value();
|
|
|
|
foreach my $t ($got_text, $expected_text)
|
|
{
|
|
$t =~ s{\A\s+}{}ms;
|
|
$t =~ s{\s+\z}{}ms;
|
|
$t =~ s{\s+}{ }ms;
|
|
}
|
|
if ($got_text ne $expected_text)
|
|
{
|
|
return $calc_prob->({param => "text"});
|
|
}
|
|
}
|
|
elsif ($type == XML_READER_TYPE_ELEMENT())
|
|
{
|
|
if ($self->_got->name() ne $self->_expected->name())
|
|
{
|
|
return $calc_prob->({param => "element_name"});
|
|
}
|
|
if (_ns($self->_got) ne _ns($self->_expected))
|
|
{
|
|
return $calc_prob->({param => "mismatch_ns"});
|
|
}
|
|
}
|
|
}
|
|
continue
|
|
{
|
|
$self->_next_elem();
|
|
}
|
|
|
|
return { verdict => 1};
|
|
}
|
|
|
|
sub _get_diag_message
|
|
{
|
|
my ($self, $status_struct) = @_;
|
|
|
|
if ($status_struct->{param} eq "nodeType")
|
|
{
|
|
return
|
|
"Different Node Type!\n"
|
|
. "Got: " . $self->_got->nodeType() . " at line " . $self->_got->lineNumber()
|
|
. "\n"
|
|
. "Expected: " . $self->_expected->nodeType() . " at line " . $self->_expected->lineNumber()
|
|
;
|
|
}
|
|
elsif ($status_struct->{param} eq "text")
|
|
{
|
|
return
|
|
"Texts differ: Got at " . $self->_got->lineNumber(). " with value <<@{[$self->_got->value()]}>> ; Expected at ". $self->_expected->lineNumber() . " with value <<@{[$self->_expected->value()]}>>.";
|
|
}
|
|
elsif ($status_struct->{param} eq "element_name")
|
|
{
|
|
return
|
|
"Got name: " . $self->_got->name(). " at " . $self->_got->lineNumber() .
|
|
" ; " .
|
|
"Expected name: " . $self->_expected->name() . " at " .$self->_expected->lineNumber();
|
|
}
|
|
elsif ($status_struct->{param} eq "mismatch_ns")
|
|
{
|
|
return
|
|
"Got Namespace: " . _ns($self->_got). " at " . $self->_got->lineNumber() .
|
|
" ; " .
|
|
"Expected Namespace: " . _ns($self->_expected) . " at " .$self->_expected->lineNumber();
|
|
}
|
|
|
|
else
|
|
{
|
|
die "Unknown param";
|
|
}
|
|
}
|
|
|
|
sub compare
|
|
{
|
|
local $Test::Builder::Level = $Test::Builder::Level+1;
|
|
|
|
my $self = shift;
|
|
|
|
$self->_next_elem();
|
|
|
|
my $status_struct = $self->_compare_loop();
|
|
my $verdict = $status_struct->{verdict};
|
|
|
|
if (!$verdict)
|
|
{
|
|
diag($self->_get_diag_message($status_struct));
|
|
}
|
|
|
|
return ok($verdict, $self->{diag_message});
|
|
}
|
|
|
|
sub is_xml_ordered
|
|
{
|
|
local $Test::Builder::Level = $Test::Builder::Level+1;
|
|
|
|
my ($got_params, $expected_params, $message) = @_;
|
|
|
|
my $comparator =
|
|
Test::XML::Ordered->new(
|
|
{
|
|
got_params => $got_params,
|
|
expected_params => $expected_params,
|
|
diag_message => $message,
|
|
}
|
|
);
|
|
|
|
return $comparator->compare();
|
|
}
|
|
|
|
my $xml_source = <<'EOF';
|
|
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
|
|
<html xmlns="http://www.w3.org/1999/xhtml" xmlns:fic="http://web-cpan.berlios.de/modules/XML-Grammar-Fortune/fiction-xml-0.2/">
|
|
<head>
|
|
<title>David vs. Goliath - Part I</title>
|
|
</head>
|
|
<body>
|
|
<div class="fiction story" xml:id="index">
|
|
<h1>David vs. Goliath - Part I</h1>
|
|
<div class="fiction section" xml:id="top">
|
|
<h2>The Top Section</h2>
|
|
<p>
|
|
King David and Goliath were standing by each other.
|
|
</p>
|
|
<p>
|
|
David said unto Goliath: "I will shoot you. I <b>swear</b> I will"
|
|
</p>
|
|
<div class="fiction section" xml:id="goliath">
|
|
<h3>Goliath's Response</h3>
|
|
<p>
|
|
Goliath was not amused.
|
|
</p>
|
|
<p>
|
|
He said to David: "Oh, really. <i>David</i>, the red-headed!".
|
|
</p>
|
|
<p>
|
|
David started listing Goliath's disadvantages:
|
|
</p>
|
|
</div>
|
|
</div>
|
|
</div>
|
|
</body>
|
|
</html>
|
|
EOF
|
|
|
|
my $final_source = <<'EOF';
|
|
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
|
|
<html xmlns="http://www.w3.org/1999/xhtml" xmlns:fic="http://web-cpan.berlios.de/modules/XML-Grammar-Fortune/fiction-xml-0.2/">
|
|
<head>
|
|
<title>David vs. Goliath - Part I</title>
|
|
</head>
|
|
<body>
|
|
<div class="fiction story" xml:id="index">
|
|
<h1>David vs. Goliath - Part I</h1>
|
|
<div class="fiction section" xml:id="top">
|
|
<h2>The Top Section</h2>
|
|
<p>
|
|
King David and Goliath were standing by each other.
|
|
</p>
|
|
<p>
|
|
David said unto Goliath: "I will shoot you. I <b>swear</b> I will"
|
|
</p>
|
|
<div class="fiction section" xml:id="goliath">
|
|
<h3>Goliath's Response</h3>
|
|
<p>
|
|
Goliath was not amused.
|
|
</p>
|
|
<p>
|
|
He said to David: "Oh, really. <i>David</i>, the red-headed!".
|
|
</p>
|
|
<p>
|
|
David started listing Goliath's disadvantages:
|
|
</p>
|
|
</div>
|
|
</div>
|
|
</div>
|
|
</body>
|
|
</html>
|
|
EOF
|
|
|
|
SKIP: {
|
|
# RT #84564
|
|
# https://bugzilla.gnome.org/show_bug.cgi?id=447899
|
|
if (XML::LibXML::LIBXML_RUNTIME_VERSION() < 20704) {
|
|
skip('Known double-free with libxml2 < 2.7.4', 1);
|
|
}
|
|
|
|
my @common = (validation => 0, load_ext_dtd => 0, no_network => 1);
|
|
# TEST
|
|
Test::XML::Ordered::is_xml_ordered(
|
|
[ string => $final_source, @common,],
|
|
[ string => $xml_source, @common,],
|
|
"foo",
|
|
);
|
|
}
|
|
|
|
# TEST
|
|
ok (1, "Finished");
|