449 lines
8.4 KiB
Perl
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");
|
|
}
|
|
|