#!/usr/local/bin/thrperl -w
my
$threaded_perl
;
BEGIN {
$threaded_perl
=
$] >=
"5.008"
&&
do
{
$Config::Config
{usethreads};
};
warn
"Need a threaded perl to test threaded mode\n"
unless
$threaded_perl
;
$XML::Essex::Constants::threading
= 1;
}
BEGIN {
eval
"use Test::Differences;1"
||
eval
"sub eq_or_diff { goto &ok }"
;
}
@Foo::ISA
=
qw( XML::Filter::Essex )
;
sub
Foo::main {
"Result Value"
;
}
my
(
$p
,
$h
,
$w
);
my
(
$out
,
$result
);
threads::shared::share(
$out
)
if
$threaded_perl
;
sub
t {
my
@main
;
@main
= (
Main
=>
shift
)
if
@_
&&
ref
$_
[0] eq
"CODE"
;
my
$doc
;
$doc
=
pop
if
@_
&&
ref
$_
[-1] eq
"SCALAR"
;
my
%opts
=
@_
;
$h
= XML::Filter::Essex->new(
@main
,
%opts
);
$out
=
undef
;
$h
->set_handler( XML::SAX::Writer->new(
Output
=> \
$out
) )
unless
$opts
{Handler};
$result
=
undef
;
if
(
defined
$doc
) {
$p
= XML::SAX::PurePerl->new(
Handler
=>
$h
);
$result
=
$p
->parse_string(
$$doc
);
}
else
{
$result
=
$h
->execute;
}
return
defined
$out
?
$out
:
$result
;
}
my
@tests
= (
sub
{
ok 1,
},
sub
{
ok t(
sub
{ 1 }, \
"<foo/>"
), 1;
},
sub
{
ok t(
sub
{
put
start_doc,
start_elt(
"foo"
, {
"a"
=> 1 } ),
end_elt(
"foo"
),
end_doc;
},
),
qr{\A<foo\s*a=['"]1['"]\s*/>\z}
;
},
sub
{ ok
$result
, \
$out
},
sub
{
ok t(
sub
{
put get
while
1;
},
\
"<foo/>"
),
qr{\A<foo\s*/>\z}
;
},
sub
{
ok t(
sub
{
put
while
get;
},
\
"<foo/>"
),
qr{\A<foo\s*/>\z}
;
},
sub
{
ok t(
sub
{
put get
until
isa
"end_doc"
;
},
\
"<foo/>"
),
qr{\A<foo\s*/>\z}
;
},
sub
{
ok t(
sub
{
while
(1) {
get;
return
put
if
isa
"end_doc"
;
put;
}
},
\
"<foo/>"
),
qr{\A<foo\s*/>\z}
;
},
sub
{
ok t(
sub
{
put start_doc, [
foo
=> {
a
=>
"b"
},
"bar"
], end_doc;
},
),
qr{<foo a=["']b["']>bar</foo>}
;
},
sub
{
ok t(
sub
{
put start_doc, start_elt(
"foo"
), end_elt, end_doc;
},
),
qr{<foo\s*/>}
;
},
sub
{
eq_or_diff t(
sub
{
put start_doc, start_elt(
"out"
),
"\n"
;
while
(1) {
get;
put
"$_"
, path,
"\n"
if
isa
"start_elt"
;
last
if
isa
"end_doc"
;
}
put end_elt,
"\n"
, end_doc;
},
\
"<foo/>"
),
<<END_PATHS
<out>
<foo>/foo
</out>
END_PATHS
},
);
plan
tests
=> 2*
@tests
;
$XML::Essex::Constants::threading
= 0;
$_
->()
for
@tests
;
$XML::Essex::Constants::threading
= 1;
$_
->()
for
@tests
;