libxml-libxml-perl/t/90threads.t

449 lines
8.4 KiB
Perl

# -*- cperl -*-
use strict;
use warnings;
use lib './t/lib';
use TestHelpers qw(utf8_slurp);
use Test::More;
use Config;
use constant MAX_THREADS => 10;
use constant MAX_LOOP => 50;
# use constant PLAN => 24;
BEGIN
{
my $will_run = 0;
if ( $Config{useithreads} )
{
if ($ENV{THREAD_TEST})
{
require threads;
require threads::shared;
$will_run = 1;
}
else
{
plan skip_all => "optional (set THREAD_TEST=1 to run these tests)";
}
}
else
{
plan skip_all => "no ithreads in this Perl";
}
if ($will_run)
{
plan tests => 24;
}
}
use XML::LibXML qw(:threads_shared);
# TEST
ok(1, 'Loaded');
my $p = XML::LibXML->new();
# TEST
ok($p, 'Parser initted.');
{
for(1..MAX_THREADS)
{
threads->new(sub {});
}
$_->join for(threads->list);
# TEST
ok(1, "Simple spawn threads with a parser in scope");
}
{
my $grammar = <<'EOF';
<grammar xmlns="http://relaxng.org/ns/structure/1.0">
<start>
<element name="foo"><empty/></element>
</start>
</grammar>
EOF
my $r = XML::LibXML::RelaxNG->new(string=>$grammar);
for(1..MAX_THREADS) {
threads->new(sub { XML::LibXML::RelaxNG->new(string=>$grammar) });
}
$_->join for(threads->list);
# TEST
ok(1, "RelaxNG");
}
{
eval { XML::LibXML->new->parse_string('foo') };
for(1..40) {
threads->new(sub { eval { XML::LibXML->new->parse_string('foo') } for(1..1000); 1; });
}
$_->join for(threads->list);
# TEST
ok(1, "XML error\n");
}
{
my $doc=XML::LibXML::Document->new;
$doc->setDocumentElement($doc->createElement('root'));
$doc->getDocumentElement->setAttribute('foo','bar');
# threads->new(sub {
# for (1..100000) {
# # a dictionary of $doc
# my $el =$doc->createElement('foo'.$_);
# $el->setAttribute('foo','bar');
# }
# return;
# });
for my $t_no (1..40) {
threads->new(sub {
for (1..1000) {
$doc->getDocumentElement;
}
return;
});
}
$_->join for(threads->list);
}
# TEST
ok(1, "accessing document elements without lock");
{
my @docs=map {
my $doc = XML::LibXML::Document->new;
$doc->setDocumentElement($doc->createElement('root'));
$doc->getDocumentElement->setAttribute('foo','bar');
$doc } 1..40;
for my $t_no (1..40) {
threads->new(sub {
my $doc=$docs[$t_no-1];
for (1..10000) {
# a dictionary of $doc
my $el =$doc->createElement('foo'.$_);
$el->setAttribute('foo','bar');
$doc->getDocumentElement->getAttribute('foo');
$el->getAttribute('foo');
}
return;
});
}
$_->join for(threads->list);
}
# TEST
ok(1, "operating on different documents without lock\n");
# operating on the same document with a lock
{
my $lock : shared;
my $doc=XML::LibXML::Document->new;
for my $t_no (1..40) {
threads->new(sub {
for (1..10000) {
lock $lock; # must lock since libxml2 uses
# a dictionary of $doc
my $el =$doc->createElement('foo');
$el->setAttribute('foo','bar');
$el->getAttribute('foo');
}
return;
});
}
$_->join for(threads->list);
}
my $xml = <<EOF;
<?xml version="1.0" encoding="utf-8"?>
<root><node><leaf/></node></root>
EOF
{
my $doc = $p->parse_string( $xml );
for(1..MAX_THREADS)
{
threads->new(sub {});
}
$_->join for(threads->list);
}
# TEST
ok(1, "Spawn threads with a document in scope");
{
my $waitfor : shared;
{
lock $waitfor;
my $doc = $p->parse_string($xml);
for(1..MAX_THREADS)
{
threads->new(sub { lock $waitfor; $doc->toString; });
}
}
$_->join for(threads->list);
# TEST
ok(1, "Spawn threads that use document that has gone out of scope from where it was created");
}
{
for(1..MAX_THREADS)
{
threads->new(sub { $p->parse_string($xml) for 1..MAX_LOOP; 1; });
}
$_->join for(threads->list);
# TEST
ok(1, "Parse a correct XML document");
}
my $xml_bad = <<EOF;
<?xml version="1.0" encoding="utf-8"?>
<root><node><leaf/></root>
EOF
{
for(1..MAX_THREADS)
{
threads->new(sub { eval { my $x = $p->parse_string($xml_bad)} for(1..MAX_LOOP); 1; });
}
$_->join for(threads->list);
# TEST
ok(1, "Parse a bad XML document\n");
}
my $xml_invalid = <<EOF;
<?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE root [
<!ELEMENT root EMPTY>
]>
<root><something/></root>
EOF
{
for(1..MAX_THREADS)
{
threads->new(sub {
for (1..MAX_LOOP) {
my $x = $p->parse_string($xml_invalid);
die if $x->is_valid;
eval { $x->validate };
die unless $@;
}
1;
});
}
$_->join for(threads->list);
# TEST
ok(1, "Parse an invalid XML document");
}
my $rngschema = <<EOF;
<?xml version="1.0"?>
<r:grammar xmlns:r="http://relaxng.org/ns/structure/1.0">
<r:start>
<r:element name="root">
<r:attribute name="id"/>
</r:element>
</r:start>
</r:grammar>
EOF
{
for(1..MAX_THREADS)
{
threads->new(
sub {
for (1..MAX_LOOP) {
my $x = $p->parse_string($xml);
eval { XML::LibXML::RelaxNG->new( string => $rngschema )->validate( $x ) };
die unless $@;
}; 1;
});
}
$_->join for(threads->list);
# TEST
ok(1, "test RNG validation errors are thread safe");
}
my $xsdschema = <<EOF;
<?xml version="1.0"?>
<xsd:schema xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<xsd:element name="root">
<xsd:attribute name="partNum" type="SKU" use="required"/>
</xsd:element>
</xsd:schema>
EOF
{
for(1..MAX_THREADS)
{
threads->new(
sub {
for (1..MAX_LOOP) {
my $x = $p->parse_string($xml);
eval { XML::LibXML::Schema->new( string => $xsdschema )->validate( $x ) };
die unless $@;
}; 1;
});
}
$_->join for(threads->list);
# TEST
ok(1, "test Schema validation errors are thread safe");
}
my $bigfile = "docs/libxml.dbk";
$xml = utf8_slurp($bigfile);
# TEST
ok($xml, 'bigfile was slurped fine.');
sub use_dom
{
my $d = shift;
my @nodes = $d->getElementsByTagName("title",1);
for(@nodes)
{
my $title = $_->toString;
}
die unless $nodes[0]->toString eq '<title>XML::LibXML</title>';
}
{
for(1..MAX_THREADS) {
threads->new(sub { my $dom = do { $p->parse_string($xml); }; use_dom($dom) for 1..5; 1; });
}
$_->join for(threads->list);
# TEST
ok(1, 'Joined all threads.');
}
{
package MyHandler;
use parent 'XML::SAX::Base';
sub AUTOLOAD
{
}
}
use XML::LibXML::SAX;
$p = XML::LibXML::SAX->new(
Handler=>MyHandler->new(),
);
# TEST
ok($p, 'XML::LibXML::SAX was initted.');
{
for(1..MAX_THREADS)
{
threads->new(sub { $p->parse_string($xml) for (1..5); 1; });
}
$_->join for threads->list;
# TEST
ok(1, 'After XML::LibXML::SAX - join.');
}
$p = XML::LibXML->new(
Handler=>MyHandler->new(),
);
$p->parse_chunk($xml);
$p->parse_chunk("",1);
{
for(1..MAX_THREADS)
{
threads->new(sub {
$p = XML::LibXML->new();
$p->parse_chunk($xml);
use_dom($p->parse_chunk("",1));
1;
});
}
$_->join for(threads->list);
# TEST
ok(1, 'XML::LibXML thread.');
}
$p = XML::LibXML->new();
# parse a big file using the same parser
{
for(1..MAX_THREADS)
{
threads->new(sub {
open my $fh, '<', $bigfile
or die "Cannot open '$bigfile'!";
my $doc = $p->parse_fh($fh);
close $fh;
2;
});
}
my @results = $_->join for(threads->list);
# TEST
ok(1, 'threads->join after opening bigfile.');
}
# create elements
{
my @n = map XML::LibXML::Element->new('bar'.$_), 1..1000;
for(1..MAX_THREADS)
{
threads->new(sub {
push @n, map XML::LibXML::Element->new('foo'.$_), 1..1000;
1;
});
}
$_->join for(threads->list);
# TEST
ok(1, 'create elements');
}
{
my $e = XML::LibXML::Element->new('foo');
for(1..MAX_THREADS) {
threads->new(sub {
if ($_[0]==1) {
my $d = XML::LibXML::Document->new();
$d->setDocumentElement($d->createElement('root'));
$d->documentElement->appendChild($e);
}
1;
},$_);
}
$_->join for(threads->list);
# TEST
ok(1, "docfrag");
}
{
my $e = XML::LibXML::Element->new('foo');
my $d = XML::LibXML::Document->new();
$d->setDocumentElement($d->createElement('root'));
for(1..MAX_THREADS) {
threads->new(sub {
if ($_[0]==1) {
$d->documentElement->appendChild($e);
}
1;
},$_);
}
$_->join for(threads->list);
# TEST
ok(1, "docfrag2");
}
{
my $e = XML::LibXML::Element->new('foo');
for(1..MAX_THREADS) {
threads->new(sub {
if ($_[0]==1) {
XML::LibXML::Element->new('root')->appendChild($e);
}
1;
},$_);
}
$_->join for(threads->list);
# TEST
ok(1, "docfrag3");
}