use Test;
use constant PLAN => 26;
use constant TIMES_THROUGH => $ENV{MEMORY_TIMES} || 100_000;
BEGIN {
plan tests => PLAN;
if ($^O ne 'linux' ) {
skip "linux platform only\n" for 1..PLAN;
} elsif (not $ENV{MEMORY_TEST}) {
skip "developers only (set MEMORY_TEST=1 to run these tests)\n" for 1..PLAN;
}
}
use XML::LibXML;
use XML::LibXML::SAX::Builder;
{
if ($^O eq 'linux' && $ENV{MEMORY_TEST}) {
# require Devel::Peek;
my $peek = 0;
ok(1);
print("# BASELINE\n");
check_mem(1);
print("# MAKE DOC IN SUB\n");
{
my $doc = make_doc();
ok($doc);
ok($doc->toString);
}
check_mem();
print("# MAKE DOC IN SUB II\n");
# same test as the first one. if this still leaks, it's
# our problem, otherwise it's perl :/
{
my $doc = make_doc();
ok($doc);
ok($doc->toString);
}
check_mem();
{
my $elem = XML::LibXML::Element->new("foo");
my $elem2= XML::LibXML::Element->new("bar");
$elem->appendChild($elem2);
ok( $elem->toString );
}
check_mem();
print("# SET DOCUMENT ELEMENT\n");
{
my $doc2 = XML::LibXML::Document->new();
make_doc_elem( $doc2 );
ok( $doc2 );
ok( $doc2->documentElement );
}
check_mem();
# multiple parsers:
print("# MULTIPLE PARSERS\n");
XML::LibXML->new(); # first parser
check_mem(1);
for (1..TIMES_THROUGH) {
my $parser = XML::LibXML->new();
}
ok(1);
check_mem();
# multiple parses
print("# MULTIPLE PARSES\n");
for (1..TIMES_THROUGH) {
my $parser = XML::LibXML->new();
my $dom = $parser->parse_string("foo");
}
ok(1);
check_mem();
# multiple failing parses
print("# MULTIPLE FAILURES\n");
for (1..TIMES_THROUGH) {
# warn("$_\n") unless $_ % 100;
my $parser = XML::LibXML->new();
eval {
my $dom = $parser->parse_string("foo"); # Thats meant to be an error, btw!
};
}
ok(1);
check_mem();
# building custom docs
print("# CUSTOM DOCS\n");
my $doc = XML::LibXML::Document->new();
for (1..TIMES_THROUGH) {
my $elem = $doc->createElement('x');
if($peek) {
warn("Doc before elem\n");
# Devel::Peek::Dump($doc);
warn("Elem alone\n");
# Devel::Peek::Dump($elem);
}
$doc->setDocumentElement($elem);
if ($peek) {
warn("Elem after attaching\n");
# Devel::Peek::Dump($elem);
warn("Doc after elem\n");
# Devel::Peek::Dump($doc);
}
}
if ($peek) {
warn("Doc should be freed\n");
# Devel::Peek::Dump($doc);
}
ok(1);
check_mem();
{
my $doc = XML::LibXML->createDocument;
for (1..TIMES_THROUGH) {
make_doc2( $doc );
}
}
ok(1);
check_mem();
print("# DTD string parsing\n");
my $dtdstr;
{
local $/; local *DTD;
open(DTD, 'example/test.dtd') || die $!;
$dtdstr = ;
$dtdstr =~ s/\r//g;
$dtdstr =~ s/[\r\n]*$//;
close DTD;
}
ok($dtdstr);
for ( 1..TIMES_THROUGH ) {
my $dtd = XML::LibXML::Dtd->parse_string($dtdstr);
}
ok(1);
check_mem();
print( "# DTD URI parsing \n");
# parse a DTD from a SYSTEM ID
for ( 1..TIMES_THROUGH ) {
my $dtd = XML::LibXML::Dtd->new('ignore', 'example/test.dtd');
}
ok(1);
check_mem();
print("# Document validation\n");
{
print "# is_valid()\n";
my $dtd = XML::LibXML::Dtd->parse_string($dtdstr);
my $xml;
eval {
local $SIG{'__WARN__'} = sub { };
$xml = XML::LibXML->new->parse_file('example/article_bad.xml');
};
for ( 1..TIMES_THROUGH ) {
my $good;
eval {
local $SIG{'__WARN__'} = sub { };
$good = $xml->is_valid($dtd);
};
}
ok(1);
check_mem();
print "# validate() \n";
for ( 1..TIMES_THROUGH ) {
eval {
local $SIG{'__WARN__'} = sub { };
$xml->validate($dtd);
};
}
ok(1);
check_mem();
}
print "# FIND NODES \n";
my $xml=<<'dromeds.xml';
1 or 2
Cranky
1 (sort of)
Aloof
(see Llama)
Friendly
dromeds.xml
{
# my $str = "";
my $str = $xml;
my $doc = XML::LibXML->new->parse_string( $str );
for ( 1..TIMES_THROUGH ) {
processMessage($xml, '/dromedaries/species' );
# my @nodes = $doc->findnodes("/foo/bar/foo");
}
ok(1);
check_mem();
}
{
my $str = "";
my $doc = XML::LibXML->new->parse_string( $str );
for ( 1..TIMES_THROUGH ) {
my $nodes = $doc->find("/foo/bar/foo");
}
ok(1);
check_mem();
}
# {
# print "# ENCODING TESTS \n";
# my $string = "test ä ø is a test string to test iso encoding";
# my $encstr = encodeToUTF8( "iso-8859-1" , $string );
# for ( 1..TIMES_THROUGH ) {
# my $str = encodeToUTF8( "iso-8859-1" , $string );
# }
# ok(1);
# check_mem();
# for ( 1..TIMES_THROUGH ) {
# my $str = encodeToUTF8( "iso-8859-2" , "abc" );
# }
# ok(1);
# check_mem();
#
# for ( 1..TIMES_THROUGH ) {
# my $str = decodeFromUTF8( "iso-8859-1" , $encstr );
# }
# ok(1);
# check_mem();
# }
{
print "# NAMESPACE TESTS \n";
my $string = '';
my $doc = XML::LibXML->new()->parse_string( $string );
for (1..TIMES_THROUGH) {
my @ns = $doc->documentElement()->getNamespaces();
# warn "ns : " . $_->localname . "=>" . $_->href foreach @ns;
my $prefix = $_->localname foreach @ns;
my $name = $doc->documentElement->nodeName;
}
check_mem();
ok(1);
}
{
print "# SAX PARSER\n";
my %xmlStrings = (
"SIMPLE" => "",
"SIMPLE TEXT" => " some text some text some text ",
"SIMPLE COMMENT" => " ",
"SIMPLE CDATA" => " ",
"SIMPLE ATTRIBUTE" => ' ',
"NAMESPACES SIMPLE" => '',
"NAMESPACES ATTRIBUTE" => '',
);
my $handler = sax_null->new;
my $parser = XML::LibXML->new;
$parser->set_handler( $handler );
check_mem();
foreach my $key ( keys %xmlStrings ) {
print "# $key \n";
for (1..TIMES_THROUGH) {
my $doc = $parser->parse_string( $xmlStrings{$key} );
}
check_mem();
}
ok(1);
}
{
print "# PUSH PARSER\n";
my %xmlStrings = (
"SIMPLE" => ["","",""],
"SIMPLE TEXT" => [" ","some text some text some text"," "],
"SIMPLE COMMENT" => ["