# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN {print "1..27\n";}
END {print "not ok 1\n" unless $loaded;}
use XML::Parser;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
# Test 2
my $parser = new XML::Parser(ProtocolEncoding => 'ISO-8859-1');
if ($parser)
{
print "ok 2\n";
}
else
{
print "not ok 2\n";
exit;
}
my @ndxstack;
my $indexok = 1;
# Need this external entity
open(ZOE, '>zoe.ent');
print ZOE "'cute'";
close(ZOE);
# XML string for tests
my $xmlstring =<<"End_of_XML;";
]>
First line in foo
Fran is &fran; and Zoe is &zoe;
1st line in bar
2nd line in bar
3rd line in bar
This, '\240', would be a bad character in UTF-8.
End_of_XML;
# Handlers
my @tests;
my $pos ='';
sub ch
{
my ($p, $str) = @_;
$tests[4]++;
$tests[5]++ if ($str =~ /2nd line/ and $p->in_element('blah'));
if ($p->in_element('boom'))
{
$tests[17]++ if $str =~ /pretty/;
$tests[18]++ if $str =~ /cute/;
}
}
sub st
{
my ($p, $el, %atts) = @_;
$ndxstack[$p->depth] = $p->element_index;
$tests[6]++ if ($el eq 'bar' and $atts{stomp} eq 'jill');
if ($el eq 'zap' and $atts{'ref'} eq 'zing')
{
$tests[7]++;
$p->default_current;
}
elsif ($el eq 'bar') {
$tests[22]++ if $p->recognized_string eq '';
}
}
sub eh
{
my ($p, $el) = @_;
$indexok = 0 unless $p->element_index == $ndxstack[$p->depth];
if ($el eq 'zap')
{
$tests[8]++;
my @old = $p->setHandlers('Char', \&newch);
$tests[19]++ if $p->current_line == 17;
$tests[20]++ if $p->current_column == 20;
$tests[23]++ if ($old[0] eq 'Char' and $old[1] == \&ch);
}
if ($el eq 'boom')
{
$p->setHandlers('Default', \&dh);
}
}
sub dh
{
my ($p, $str) = @_;
if ($str =~ /doozy/)
{
$tests[9]++;
$pos = $p->position_in_context(1);
}
$tests[10]++ if $str =~ /^setHandlers('Char' => \&ch,
'Start' => \&st,
'End' => \&eh,
'Proc' => \&pi,
'Notation' => \¬e,
'Unparsed' => \&unp,
'ExternEnt' => \&extent,
'ExternEntFin' => sub {close(FOO);}
);
};
if ($@)
{
print "not ok 3\n";
exit;
}
print "ok 3\n";
# Test 4..20
eval {
$parser->parsestring($xmlstring);
};
if ($@)
{
print "Parse error:\n$@";
}
else
{
$tests[21]++;
}
unlink('zoe.ent') if (-f 'zoe.ent');
for (4 .. 23)
{
print "not " unless $tests[$_];
print "ok $_\n";
}
$cmpstr =<< 'End_of_Cmp;';
2nd line in bar
3rd line in bar
===================^
End_of_Cmp;
if ($cmpstr ne $pos)
{
print "not ";
}
print "ok 24\n";
print "not " unless $indexok;
print "ok 25\n";
# Test that memory leak through autovivifying symbol table entries is fixed.
my $count = 0;
$parser = new XML::Parser(
Handlers => {
Start => sub { $count++ }
}
);
$xmlstring = 'Sea';
eval {
$parser->parsestring($xmlstring);
};
if($count != 2) {
print "not ";
}
print "ok 26\n";
if(defined(*{$xmlstring})) {
print "not ";
}
print "ok 27\n";