summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
Diffstat (limited to 't')
-rw-r--r--t/astress.t264
-rw-r--r--t/cdata.t40
-rw-r--r--t/decl.t166
-rw-r--r--t/defaulted.t50
-rw-r--r--t/encoding.t110
-rw-r--r--t/ext.ent1
-rw-r--r--t/ext2.ent1
-rw-r--r--t/external_ent.t70
-rw-r--r--t/file.t15
-rw-r--r--t/finish.t32
-rw-r--r--t/foo.dtd20
-rw-r--r--t/namespaces.t133
-rw-r--r--t/parament.t117
-rw-r--r--t/partial.t40
-rw-r--r--t/skip.t53
-rw-r--r--t/stream.t50
-rw-r--r--t/styles.t62
17 files changed, 1224 insertions, 0 deletions
diff --git a/t/astress.t b/t/astress.t
new file mode 100644
index 0000000..210760b
--- /dev/null
+++ b/t/astress.t
@@ -0,0 +1,264 @@
+# 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;";
+<!DOCTYPE foo
+ [
+ <!NOTATION bar PUBLIC "qrs">
+ <!ENTITY zinger PUBLIC "xyz" "abc" NDATA bar>
+ <!ENTITY fran SYSTEM "fran-def">
+ <!ENTITY zoe SYSTEM "zoe.ent">
+ ]>
+<foo>
+ First line in foo
+ <boom>Fran is &fran; and Zoe is &zoe;</boom>
+ <bar id="jack" stomp="jill">
+ <?line-noise *&*&^&<< ?>
+ 1st line in bar
+ <blah> 2nd line in bar </blah>
+ 3rd line in bar <!-- Isn't this a doozy -->
+ </bar>
+ <zap ref="zing" />
+ This, '\240', would be a bad character in UTF-8.
+</foo>
+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 '<bar id="jack" stomp="jill">';
+ }
+}
+
+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 =~ /^<zap/;
+}
+
+sub pi
+{
+ my ($p, $tar, $data) = @_;
+
+ $tests[11]++ if ($tar eq 'line-noise' and $data =~ /&\^&<</);
+}
+
+sub note
+{
+ my ($p, $name, $base, $sysid, $pubid) = @_;
+
+ $tests[12]++ if ($name eq 'bar' and $pubid eq 'qrs');
+}
+
+sub unp
+{
+ my ($p, $name, $base, $sysid, $pubid, $notation) = @_;
+
+ $tests[13]++ if ($name eq 'zinger' and $pubid eq 'xyz'
+ and $sysid eq 'abc' and $notation eq 'bar');
+}
+
+sub newch
+{
+ my ($p, $str) = @_;
+
+ if ($] < 5.007001) {
+ $tests[14]++ if $str =~ /'\302\240'/;
+ }
+ else {
+ $tests[14]++ if $str =~ /'\xa0'/;
+ }
+}
+
+sub extent
+{
+ my ($p, $base, $sys, $pub) = @_;
+
+ if ($sys eq 'fran-def')
+ {
+ $tests[15]++;
+ return 'pretty';
+ }
+ elsif ($sys eq 'zoe.ent')
+ {
+ $tests[16]++;
+
+ open(FOO, $sys) or die "Couldn't open $sys";
+ return *FOO;
+ }
+}
+
+eval {
+ $parser->setHandlers('Char' => \&ch,
+ 'Start' => \&st,
+ 'End' => \&eh,
+ 'Proc' => \&pi,
+ 'Notation' => \&note,
+ '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;';
+ <blah> 2nd line in bar </blah>
+ 3rd line in bar <!-- Isn't this a doozy -->
+===================^
+ </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 = '<a><b>Sea</b></a>';
+
+eval {
+ $parser->parsestring($xmlstring);
+};
+
+if($count != 2) {
+ print "not ";
+}
+print "ok 26\n";
+
+if(defined(*{$xmlstring})) {
+ print "not ";
+}
+print "ok 27\n";
+
diff --git a/t/cdata.t b/t/cdata.t
new file mode 100644
index 0000000..5e1190b
--- /dev/null
+++ b/t/cdata.t
@@ -0,0 +1,40 @@
+BEGIN {print "1..2\n";}
+END {print "not ok 1\n" unless $loaded;}
+use XML::Parser;
+$loaded = 1;
+print "ok 1\n";
+
+my $count = 0;
+
+my $cdata_part = "<<< & > '' << &&&>&&&&;<";
+
+my $doc = "<foo> hello <![CDATA[$cdata_part]]> there</foo>";
+
+my $acc = '';
+
+sub ch {
+ my ($xp, $data) = @_;
+
+ $acc .= $data;
+}
+
+sub stcd {
+ my $xp = shift;
+ $xp->setHandlers(Char => \&ch);
+}
+
+sub ecd {
+ my $xp = shift;
+ $xp->setHandlers(Char => 0);
+}
+
+$parser = new XML::Parser(ErrorContext => 2,
+ Handlers => {CdataStart => \&stcd,
+ CdataEnd => \&ecd});
+
+$parser->parse($doc);
+
+print "not "
+ unless ($acc eq $cdata_part);
+print "ok 2\n";
+
diff --git a/t/decl.t b/t/decl.t
new file mode 100644
index 0000000..b89d6de
--- /dev/null
+++ b/t/decl.t
@@ -0,0 +1,166 @@
+BEGIN {print "1..30\n";}
+END {print "not ok 1\n" unless $loaded;}
+use XML::Parser;
+$loaded = 1;
+print "ok 1\n";
+
+my $bigval =<<'End_of_bigval;';
+This is a large string value to test whether the declaration parser still
+works when the entity or attribute default value may be broken into multiple
+calls to the default handler.
+01234567890123456789012345678901234567890123456789012345678901234567890123456789
+01234567890123456789012345678901234567890123456789012345678901234567890123456789
+01234567890123456789012345678901234567890123456789012345678901234567890123456789
+01234567890123456789012345678901234567890123456789012345678901234567890123456789
+01234567890123456789012345678901234567890123456789012345678901234567890123456789
+01234567890123456789012345678901234567890123456789012345678901234567890123456789
+01234567890123456789012345678901234567890123456789012345678901234567890123456789
+01234567890123456789012345678901234567890123456789012345678901234567890123456789
+01234567890123456789012345678901234567890123456789012345678901234567890123456789
+01234567890123456789012345678901234567890123456789012345678901234567890123456789
+01234567890123456789012345678901234567890123456789012345678901234567890123456789
+01234567890123456789012345678901234567890123456789012345678901234567890123456789
+01234567890123456789012345678901234567890123456789012345678901234567890123456789
+End_of_bigval;
+
+$bigval =~ s/\n/ /g;
+
+my $docstr =<<"End_of_Doc;";
+<?xml version="1.0" encoding="ISO-8859-1" ?>
+<!DOCTYPE foo SYSTEM 't/foo.dtd'
+ [
+ <!ENTITY alpha 'a'>
+ <!ELEMENT junk ((bar|foo|xyz+), zebra*)>
+ <!ELEMENT xyz (#PCDATA)>
+ <!ELEMENT zebra (#PCDATA|em|strong)*>
+ <!ATTLIST junk
+ id ID #REQUIRED
+ version CDATA #FIXED '1.0'
+ color (red|green|blue) 'green'
+ foo NOTATION (x|y|z) #IMPLIED>
+ <!ENTITY skunk "stinky animal">
+ <!ENTITY big "$bigval">
+ <!-- a comment -->
+ <!NOTATION gif SYSTEM 'http://www.somebody.com/specs/GIF31.TXT'>
+ <!ENTITY logo PUBLIC '//Widgets Corp/Logo' 'logo.gif' NDATA gif>
+ <?DWIM a useless processing instruction ?>
+ <!ELEMENT bar ANY>
+ <!ATTLIST bar big CDATA '$bigval'>
+ ]>
+<foo/>
+End_of_Doc;
+
+my $entcnt = 0;
+my %ents;
+my @tests;
+
+sub enth1 {
+ my ($p, $name, $val, $sys, $pub, $notation) = @_;
+
+ $tests[2]++ if ($name eq 'alpha' and $val eq 'a');
+ $tests[3]++ if ($name eq 'skunk' and $val eq 'stinky animal');
+ $tests[4]++ if ($name eq 'logo' and !defined($val) and
+ $sys eq 'logo.gif' and $pub eq '//Widgets Corp/Logo'
+ and $notation eq 'gif');
+}
+
+my $parser = new XML::Parser(ErrorContext => 2,
+ NoLWP => 1,
+ ParseParamEnt => 1,
+ Handlers => {Entity => \&enth1});
+
+$parser->parse($docstr);
+
+sub eleh {
+ my ($p, $name, $model) = @_;
+
+ if ($name eq 'junk') {
+ $tests[5]++ if $model eq '((bar|foo|xyz+),zebra*)';
+ $tests[6]++ if $model->isseq;
+ my @parts = $model->children;
+ $tests[7]++ if $parts[0]->ischoice;
+ my @cparts = $parts[0]->children;
+ $tests[8]++ if $cparts[0] eq 'bar';
+ $tests[9]++ if $cparts[1] eq 'foo';
+ $tests[10]++ if $cparts[2] eq 'xyz+';
+ $tests[11]++ if $cparts[2]->name eq 'xyz';
+ $tests[12]++ if $parts[1]->name eq 'zebra';
+ $tests[13]++ if $parts[1]->quant eq '*';
+ }
+
+ if ($name eq 'xyz') {
+ $tests[14]++ if ($model->ismixed and ! defined($model->children));
+ }
+
+ if ($name eq 'zebra') {
+ $tests[15]++ if ($model->ismixed and ($model->children)[1] eq 'strong');
+ }
+
+ if ($name eq 'bar') {
+ $tests[16]++ if $model->isany;
+ }
+}
+
+sub enth2 {
+ my ($p, $name, $val, $sys, $pub, $notation) = @_;
+
+ $tests[17]++ if ($name eq 'alpha' and $val eq 'a');
+ $tests[18]++ if ($name eq 'skunk' and $val eq 'stinky animal');
+ $tests[19]++ if ($name eq 'big' and $val eq $bigval);
+ $tests[20]++ if ($name eq 'logo' and !defined($val) and
+ $sys eq 'logo.gif' and $pub eq '//Widgets Corp/Logo'
+ and $notation eq 'gif');
+}
+
+sub doc {
+ my ($p, $name, $sys, $pub, $intdecl) = @_;
+
+ $tests[21]++ if $name eq 'foo';
+ $tests[22]++ if $sys eq 't/foo.dtd';
+ $tests[23]++ if $intdecl
+}
+
+sub att {
+ my ($p, $elname, $attname, $type, $default, $fixed) = @_;
+
+ $tests[24]++ if ($elname eq 'junk' and $attname eq 'id'
+ and $type eq 'ID' and $default eq '#REQUIRED'
+ and not $fixed);
+ $tests[25]++ if ($elname eq 'junk' and $attname eq 'version'
+ and $type eq 'CDATA' and $default eq "'1.0'" and $fixed);
+ $tests[26]++ if ($elname eq 'junk' and $attname eq 'color'
+ and $type eq '(red|green|blue)'
+ and $default eq "'green'");
+ $tests[27]++ if ($elname eq 'bar' and $attname eq 'big' and $default eq
+ "'$bigval'");
+ $tests[28]++ if ($elname eq 'junk' and $attname eq 'foo'
+ and $type eq 'NOTATION(x|y|z)' and $default eq '#IMPLIED');
+
+}
+
+sub xd {
+ my ($p, $version, $enc, $stand) = @_;
+
+ if (defined($version)) {
+ if ($version eq '1.0' and $enc eq 'ISO-8859-1' and not defined($stand)) {
+ $tests[29]++;
+ }
+ }
+ else {
+ $tests[30]++ if $enc eq 'x-sjis-unicode';
+ }
+}
+
+$parser->setHandlers(Entity => \&enth2,
+ Element => \&eleh,
+ Attlist => \&att,
+ Doctype => \&doc,
+ XMLDecl => \&xd);
+
+$| = 1;
+$parser->parse($docstr);
+
+for (2 .. 30) {
+ print "not " unless $tests[$_];
+ print "ok $_\n";
+}
diff --git a/t/defaulted.t b/t/defaulted.t
new file mode 100644
index 0000000..a3dfb91
--- /dev/null
+++ b/t/defaulted.t
@@ -0,0 +1,50 @@
+BEGIN {print "1..4\n";}
+END {print "not ok 1\n" unless $loaded;}
+use XML::Parser;
+$loaded = 1;
+print "ok 1\n";
+
+$doc =<<'End_of_Doc;';
+<!DOCTYPE foo [
+<!ATTLIST bar zz CDATA 'there'>
+]>
+<foo>
+ <bar xx="hello"/>
+ <bar zz="other"/>
+</foo>
+End_of_Doc;
+
+sub st {
+ my $xp = shift;
+ my $el = shift;
+
+ if ($el eq 'bar') {
+ my %atts = @_;
+ my %isdflt;
+ my $specified = $xp->specified_attr;
+
+ for (my $i = $specified; $i < @_; $i += 2) {
+ $isdflt{$_[$i]} = 1;
+ }
+
+ if (defined $atts{xx}) {
+ print 'not '
+ if $isdflt{'xx'};
+ print "ok 2\n";
+
+ print 'not '
+ unless $isdflt{'zz'};
+ print "ok 3\n";
+ }
+ else {
+ print 'not '
+ if $isdflt{'zz'};
+ print "ok 4\n";
+ }
+
+ }
+}
+
+$p = new XML::Parser(Handlers => {Start => \&st});
+
+$p->parse($doc);
diff --git a/t/encoding.t b/t/encoding.t
new file mode 100644
index 0000000..f0df1dd
--- /dev/null
+++ b/t/encoding.t
@@ -0,0 +1,110 @@
+BEGIN {print "1..6\n";}
+END {print "not ok 1\n" unless $loaded;}
+use XML::Parser;
+$loaded = 1;
+print "ok 1\n";
+
+################################################################
+# Check encoding
+
+my $xmldec = "<?xml version='1.0' encoding='x-sjis-unicode' ?>\n";
+
+my $docstring=<<"End_of_doc;";
+<\x8e\x83>\x90\x46\x81\x41\x98\x61\x81\x41\x99\x44
+</\x8e\x83>
+End_of_doc;
+
+my $doc = $xmldec . $docstring;
+
+my @bytes;
+my $lastel;
+
+sub text {
+ my ($xp, $data) = @_;
+
+ push(@bytes, unpack('U0C*', $data)); # was fixed 5.10
+}
+
+sub start {
+ my ($xp, $el) = @_;
+
+ $lastel = $el;
+}
+
+my $p = new XML::Parser(Handlers => {Start => \&start, Char => \&text});
+
+$p->parse($doc);
+
+my $exptag = ($] < 5.006)
+ ? "\xe7\xa5\x89" # U+7949 blessings 0x8e83
+ : chr(0x7949);
+
+my @expected = (0xe8, 0x89, 0xb2, # U+8272 beauty 0x9046
+ 0xe3, 0x80, 0x81, # U+3001 comma 0x8141
+ 0xe5, 0x92, 0x8c, # U+548C peace 0x9861
+ 0xe3, 0x80, 0x81, # U+3001 comma 0x8141
+ 0xe5, 0x83, 0x96, # U+50D6 joy 0x9944
+ 0x0a);
+
+if ($lastel eq $exptag) {
+ print "ok 2\n";
+}
+else {
+ print "not ok 2\n";
+}
+
+if (@bytes != @expected) {
+ print "not ok 3\n";
+}
+else {
+ my $i;
+ for ($i = 0; $i < @expected; $i++) {
+ if ($bytes[$i] != $expected[$i]) {
+ print "not ok 3\n";
+ exit;
+ }
+ }
+ print "ok 3\n";
+}
+
+$lastel = '';
+
+$p->parse($docstring, ProtocolEncoding => 'X-SJIS-UNICODE');
+
+if ($lastel eq $exptag) {
+ print "ok 4\n";
+}
+else {
+ print "not ok 4\n";
+}
+
+# Test the CP-1252 Win-Latin-1 mapping
+
+$docstring = qq(<?xml version='1.0' encoding='WINDOWS-1252' ?>
+<doc euro="\x80" lsq="\x91" rdq="\x94" />
+);
+
+my %attr;
+
+sub get_attr {
+ my ($xp, $el, @list) = @_;
+ %attr = @list;
+}
+
+$p = new XML::Parser(Handlers => {Start => \&get_attr});
+
+eval{ $p->parse($docstring) };
+
+if($@) {
+ print "not "; # couldn't load the map
+}
+print "ok 5\n";
+
+if( $attr{euro} ne ( $] < 5.006 ? "\xE2\x82\xAC" : chr(0x20AC) )
+ or $attr{lsq} ne ( $] < 5.006 ? "\xE2\x80\x98" : chr(0x2018) )
+ or $attr{rdq} ne ( $] < 5.006 ? "\xE2\x80\x9D" : chr(0x201D) )
+) {
+ print "not ";
+}
+print "ok 6\n";
+
diff --git a/t/ext.ent b/t/ext.ent
new file mode 100644
index 0000000..da72814
--- /dev/null
+++ b/t/ext.ent
@@ -0,0 +1 @@
+<!ATTLIST ext type CDATA "flag">
diff --git a/t/ext2.ent b/t/ext2.ent
new file mode 100644
index 0000000..cd96a84
--- /dev/null
+++ b/t/ext2.ent
@@ -0,0 +1 @@
+<more/>
diff --git a/t/external_ent.t b/t/external_ent.t
new file mode 100644
index 0000000..6d62aff
--- /dev/null
+++ b/t/external_ent.t
@@ -0,0 +1,70 @@
+BEGIN {print "1..5\n";}
+END {print "not ok 1\n" unless $loaded;}
+use XML::Parser;
+$loaded = 1;
+print "ok 1\n";
+
+################################################################
+# Check default external entity handler
+
+
+my $txt = '';
+
+sub txt {
+ my ($xp, $data) = @_;
+
+ $txt .= $data;
+}
+
+my $docstring =<<'End_of_XML;';
+<!DOCTYPE foo [
+ <!ENTITY a SYSTEM "a.ent">
+ <!ENTITY b SYSTEM "b.ent">
+ <!ENTITY c SYSTEM "c.ent">
+]>
+<foo>
+a = "&a;"
+b = "&b;"
+
+
+And here they are again in reverse order:
+b = "&b;"
+a = "&a;"
+
+</foo>
+End_of_XML;
+
+open(ENT, '>a.ent') or die "Couldn't open a.ent for writing";
+print ENT "This ('&c;') is a quote of c";
+close(ENT);
+
+open(ENT, '>b.ent') or die "Couldn't open b.ent for writing";
+print ENT "Hello, I'm B";
+close(ENT);
+
+open(ENT, '>c.ent') or die "Couldn't open c.ent for writing";
+print ENT "Hurrah for C";
+close(ENT);
+
+my $p = new XML::Parser(Handlers => {Char => \&txt});
+
+$p->parse($docstring);
+
+my %check = (a => "This ('Hurrah for C') is a quote of c",
+ b => "Hello, I'm B");
+
+my $tstcnt = 2;
+
+while ($txt =~ /([ab]) = "(.*)"/g) {
+ my ($k, $v) = ($1, $2);
+
+ unless ($check{$k} eq $v) {
+ print "not ";
+ }
+ print "ok $tstcnt\n";
+ $tstcnt++;
+}
+
+unlink('a.ent');
+unlink('b.ent');
+unlink('c.ent');
diff --git a/t/file.t b/t/file.t
new file mode 100644
index 0000000..d7c4f53
--- /dev/null
+++ b/t/file.t
@@ -0,0 +1,15 @@
+BEGIN {print "1..2\n";}
+END {print "not ok 1\n" unless $loaded;}
+use XML::Parser;
+$loaded = 1;
+print "ok 1\n";
+
+my $count = 0;
+
+$parser = new XML::Parser(ErrorContext => 2);
+$parser->setHandlers(Comment => sub {$count++;});
+
+$parser->parsefile('samples/REC-xml-19980210.xml');
+
+print "not " unless $count == 37;
+print "ok 2\n";
diff --git a/t/finish.t b/t/finish.t
new file mode 100644
index 0000000..45cd86c
--- /dev/null
+++ b/t/finish.t
@@ -0,0 +1,32 @@
+BEGIN {print "1..3\n";}
+END {print "not ok 1\n" unless $loaded;}
+use XML::Parser;
+$loaded = 1;
+print "ok 1\n";
+
+my $stcount = 0;
+my $encount = 0;
+
+sub st {
+ my ($exp, $el) = @_;
+ $stcount++;
+ $exp->finish if $el eq 'loc';
+}
+
+sub end {
+ $encount++;
+}
+
+$parser = new XML::Parser(Handlers => {Start => \&st,
+ End => \&end
+ },
+ ErrorContext => 2);
+
+
+$parser->parsefile('samples/REC-xml-19980210.xml');
+
+print "not " unless $stcount == 12;
+print "ok 2\n";
+
+print "not " unless $encount == 8;
+print "ok 3\n";
diff --git a/t/foo.dtd b/t/foo.dtd
new file mode 100644
index 0000000..fb026bf
--- /dev/null
+++ b/t/foo.dtd
@@ -0,0 +1,20 @@
+<?xml encoding="x-sjis-unicode"?>
+<!ENTITY joy "™D">
+
+<!ATTLIST foo zz CDATA 'here'>
+
+<!ENTITY % bar 'IGNORE'>
+<!ENTITY % foo 'IGNORE'>
+
+<!ENTITY more SYSTEM 'ext2.ent'>
+
+<!ENTITY % ext SYSTEM 'ext.ent'>
+%ext;
+
+<![%bar;[
+<!ATTLIST bar xyz (a|b|c) 'b'>
+]]>
+
+<![%foo;[
+<!ATTLIST foo top CDATA "hello">
+]]>
diff --git a/t/namespaces.t b/t/namespaces.t
new file mode 100644
index 0000000..bbc48d7
--- /dev/null
+++ b/t/namespaces.t
@@ -0,0 +1,133 @@
+BEGIN {print "1..16\n";}
+END {print "not ok 1\n" unless $loaded;}
+use XML::Parser;
+$loaded = 1;
+print "ok 1\n";
+
+################################################################
+# Check namespaces
+
+$docstring =<<'End_of_doc;';
+<foo xmlns="urn:blazing-saddles"
+ xmlns:bar="urn:young-frankenstein"
+ bar:alpha="17">
+ <zebra xyz="nothing"/>
+ <tango xmlns=""
+ xmlns:zoo="urn:high-anxiety"
+ beta="blue"
+ zoo:beta="green"
+ bar:beta="red">
+ <?nscheck?>
+ <zoo:here/>
+ <there/>
+ </tango>
+ <everywhere/>
+</foo>
+End_of_doc;
+
+my $gname;
+
+sub init {
+ my $xp = shift;
+ $gname = $xp->generate_ns_name('alpha', 'urn:young-frankenstein');
+}
+
+sub start {
+ my $xp = shift;
+ my $el = shift;
+
+ if ($el eq 'foo') {
+ print "not " unless $xp->namespace($el) eq 'urn:blazing-saddles';
+ print "ok 2\n";
+
+ print "not " unless $xp->new_ns_prefixes == 2;
+ print "ok 3\n";
+
+ while (@_) {
+ my $att = shift;
+ my $val = shift;
+ if ($att eq 'alpha') {
+ print "not " unless $xp->eq_name($gname, $att);
+ print "ok 4\n";
+ last;
+ }
+ }
+ }
+ elsif ($el eq 'zebra') {
+ print "not " unless $xp->new_ns_prefixes == 0;
+ print "ok 5\n";
+
+ print "not " unless $xp->namespace($el) eq 'urn:blazing-saddles';
+ print "ok 6\n";
+ }
+ elsif ($el eq 'tango') {
+ print "not " if $xp->namespace($_[0]);
+ print "ok 8\n";
+
+ print "not " unless $_[0] eq $_[2];
+ print "ok 9\n";
+
+ print "not " if $xp->eq_name($_[0], $_[2]);
+ print "ok 10\n";
+
+ my $cnt = 0;
+ foreach ($xp->new_ns_prefixes) {
+ $cnt++ if $_ eq '#default';
+ $cnt++ if $_ eq 'zoo';
+ }
+
+ print "not " unless $cnt == 2;
+ print "ok 11\n";
+ }
+}
+
+sub end {
+ my $xp = shift;
+ my $el = shift;
+
+ if ($el eq 'zebra') {
+ print "not "
+ unless $xp->expand_ns_prefix('#default') eq 'urn:blazing-saddles';
+ print "ok 7\n";
+ }
+ elsif ($el eq 'everywhere') {
+ print "not " unless $xp->namespace($el) eq 'urn:blazing-saddles';
+ print "ok 16\n";
+ }
+}
+
+sub proc {
+ my $xp = shift;
+ my $target = shift;
+
+ if ($target eq 'nscheck') {
+ print "not " if $xp->new_ns_prefixes > 0;
+ print "ok 12\n";
+
+ my $cnt = 0;
+ foreach ($xp->current_ns_prefixes) {
+ $cnt++ if $_ eq 'zoo';
+ $cnt++ if $_ eq 'bar';
+ }
+
+ print "not " unless $cnt == 2;
+ print "ok 13\n";
+
+ print "not "
+ unless $xp->expand_ns_prefix('bar') eq 'urn:young-frankenstein';
+ print "ok 14\n";
+
+ print "not "
+ unless $xp->expand_ns_prefix('zoo') eq 'urn:high-anxiety';
+ print "ok 15\n";
+ }
+}
+
+my $parser = new XML::Parser(ErrorContext => 2,
+ Namespaces => 1,
+ Handlers => {Start => \&start,
+ End => \&end,
+ Proc => \&proc,
+ Init => \&init});
+
+$parser->parse($docstring);
diff --git a/t/parament.t b/t/parament.t
new file mode 100644
index 0000000..0a04277
--- /dev/null
+++ b/t/parament.t
@@ -0,0 +1,117 @@
+BEGIN {print "1..12\n";}
+END {print "not ok 1\n" unless $loaded;}
+use XML::Parser;
+$loaded = 1;
+print "ok 1\n";
+
+my $internal_subset =<<'End_of_internal;';
+[
+ <!ENTITY % foo "IGNORE">
+ <!ENTITY % bar "INCLUDE">
+ <!ENTITY more SYSTEM "t/ext2.ent">
+]
+End_of_internal;
+
+my $doc =<<"End_of_doc;";
+<?xml version="1.0" encoding="ISO-8859-1"?>
+<!DOCTYPE foo SYSTEM "t/foo.dtd"
+$internal_subset>
+<foo>Happy, happy
+<bar>&joy;, &joy;</bar>
+<ext/>
+&more;
+</foo>
+End_of_doc;
+
+my $gotinclude = 0;
+my $gotignore = 0;
+my $doctype_called = 0;
+my $internal_exists = 0;
+my $gotmore = 0;
+
+my $bartxt = '';
+
+sub start {
+ my ($xp, $el, %atts) = @_;
+
+ if ($el eq 'foo') {
+ print "not " if defined($atts{top});
+ print "ok 2\n";
+ print "not " unless defined($atts{zz});
+ print "ok 3\n";
+ }
+ elsif ($el eq 'bar') {
+ print "not " unless (defined $atts{xyz} and $atts{xyz} eq 'b');
+ print "ok 4\n";
+ }
+ elsif ($el eq 'ext') {
+ print "not " unless (defined $atts{type} and $atts{type} eq 'flag');
+ print "ok 5\n";
+ }
+ elsif ($el eq 'more') {
+ $gotmore = 1;
+ }
+}
+
+sub char {
+ my ($xp, $text) = @_;
+
+ $bartxt .= $text if $xp->current_element eq 'bar';
+}
+
+sub attl {
+ my ($xp, $el, $att, $type, $dflt, $fixed) = @_;
+
+ $gotinclude = 1 if ($el eq 'bar' and $att eq 'xyz' and $dflt eq "'b'");
+ $gotignore = 1 if ($el eq 'foo' and $att eq 'top' and $dflt eq '"hello"');
+}
+
+sub dtd {
+ my ($xp, $name, $sysid, $pubid, $internal) = @_;
+
+ $doctype_called = 1;
+ $internal_exists = $internal;
+}
+
+$p = new XML::Parser(ParseParamEnt => 1,
+ ErrorContext => 2,
+ Handlers => {Start => \&start,
+ Char => \&char,
+ Attlist => \&attl,
+ Doctype => \&dtd
+ }
+ );
+
+$p->parse($doc);
+
+print "not " unless $gotmore;
+print "ok 6\n";
+
+print "not " unless $bartxt eq ($] < 5.006)
+ ? "\xe5\x83\x96, \xe5\x83\x96"
+ : chr(0x50d6). ", " . chr(0x50d6);
+print "ok 7\n";
+
+print "not " unless $gotinclude;
+print "ok 8\n";
+
+print "not " if $gotignore;
+print "ok 9\n";
+
+print "not " unless $doctype_called;
+print "ok 10\n";
+
+print "not " unless $internal_exists;
+print "ok 11\n";
+
+$doc =~ s/[\s\n]+\[[^]]*\][\s\n]+//m;
+
+$p->setHandlers(Start => sub {
+ my ($xp,$el,%atts) = @_;
+ if ($el eq 'foo') {
+ print "not " unless defined($atts{zz});
+ print "ok 12\n";
+ }
+ });
+
+$p->parse($doc);
diff --git a/t/partial.t b/t/partial.t
new file mode 100644
index 0000000..c94c9b8
--- /dev/null
+++ b/t/partial.t
@@ -0,0 +1,40 @@
+BEGIN {print "1..3\n";}
+END {print "not ok 1\n" unless $loaded;}
+use XML::Parser;
+$loaded = 1;
+print "ok 1\n";
+
+my $cnt = 0;
+my $str;
+
+sub tmpchar {
+ my ($xp, $data) = @_;
+
+ if ($xp->current_element eq 'day') {
+ $str = $xp->original_string;
+ $xp->setHandlers(Char => 0);
+ }
+}
+
+my $p = new XML::Parser(Handlers => {Comment => sub {$cnt++;},
+ Char => \&tmpchar
+ });
+
+my $xpnb = $p->parse_start;
+
+open(REC, 'samples/REC-xml-19980210.xml');
+
+while (<REC>) {
+ $xpnb->parse_more($_);
+}
+
+close(REC);
+
+$xpnb->parse_done;
+
+print "not " unless $cnt == 37;
+print "ok 2\n";
+
+print "not " unless $str eq '&draft.day;';
+print "ok 3\n";
+
diff --git a/t/skip.t b/t/skip.t
new file mode 100644
index 0000000..6cde2a7
--- /dev/null
+++ b/t/skip.t
@@ -0,0 +1,53 @@
+BEGIN {print "1..4\n";}
+END {print "not ok 1\n" unless $loaded;}
+use XML::Parser;
+$loaded = 1;
+print "ok 1\n";
+
+my $cmnt_count = 0;
+my $pi_count = 0;
+my $between_count = 0;
+my $authseen = 0;
+
+sub init {
+ my $xp = shift;
+ $xp->skip_until(1); # Skip through prolog
+}
+
+sub proc {
+ $pi_count++;
+}
+
+sub cmnt {
+ $cmnt_count++;
+}
+
+sub start {
+ my ($xp, $el) = @_;
+ my $ndx = $xp->element_index;
+ if (! $authseen and $el eq 'authlist') {
+ $authseen = 1;
+ $xp->skip_until(2000);
+ }
+ elsif ($authseen and $ndx < 2000) {
+ $between_count++;
+ }
+}
+
+my $p = new XML::Parser(Handlers => {Init => \&init,
+ Start => \&start,
+ Comment => \&cmnt,
+ Proc => \&proc
+ });
+
+$p->parsefile('samples/REC-xml-19980210.xml');
+
+print "not " if $between_count;
+print "ok 2\n";
+
+print "not " if $pi_count;
+print "ok 3\n";
+
+print "not " unless $cmnt_count == 5;
+print "ok 4\n";
+
diff --git a/t/stream.t b/t/stream.t
new file mode 100644
index 0000000..92b7994
--- /dev/null
+++ b/t/stream.t
@@ -0,0 +1,50 @@
+BEGIN {print "1..3\n";}
+END {print "not ok 1\n" unless $loaded;}
+use XML::Parser;
+$loaded = 1;
+print "ok 1\n";
+
+my $delim = '------------123453As23lkjlklz877';
+my $file = 'samples/REC-xml-19980210.xml';
+my $tmpfile = 'stream.tmp';
+
+my $cnt = 0;
+
+
+open(OUT, ">$tmpfile") or die "Couldn't open $tmpfile for output";
+open(IN, $file) or die "Couldn't open $file for input";
+
+while (<IN>) {
+ print OUT;
+}
+
+close(IN);
+print OUT "$delim\n";
+
+open(IN, $file);
+while (<IN>) {
+ print OUT;
+}
+
+close(IN);
+close(OUT);
+
+my $parser = new XML::Parser(Stream_Delimiter => $delim,
+ Handlers => {Comment => sub {$cnt++;}});
+
+open(FOO, $tmpfile);
+
+$parser->parse(*FOO);
+
+print "not " if ($cnt != 37);
+print "ok 2\n";
+
+$cnt = 0;
+
+$parser->parse(*FOO);
+
+print "not " if ($cnt != 37);
+print "ok 3\n";
+
+close(FOO);
+unlink($tmpfile);
diff --git a/t/styles.t b/t/styles.t
new file mode 100644
index 0000000..b4567ce
--- /dev/null
+++ b/t/styles.t
@@ -0,0 +1,62 @@
+use Test;
+BEGIN { plan tests => 13 }
+use XML::Parser;
+use IO::File;
+
+my $xmlstr = '<foo>bar</foo>';
+
+{
+ # Debug style
+ my $parser = XML::Parser->new(Style => 'Debug');
+ ok($parser);
+
+ my $tmpfile = IO::File->new_tmpfile();
+ open(OLDERR, ">&STDERR");
+ open(STDERR, ">&" . $tmpfile->fileno) || die "Cannot re-open STDERR : $!";
+
+ $parser->parse($xmlstr);
+
+ close(STDERR);
+ open(STDERR, ">&OLDERR");
+ close(OLDERR);
+
+ seek($tmpfile, 0, 0);
+ my $warn = 0;
+ $warn++ while (<$tmpfile>);
+ ok($warn, 3, "Check we got three warnings out");
+}
+
+{
+ # Object style
+ my $parser = XML::Parser->new(Style => 'Objects');
+ ok($parser);
+
+ my $tree = $parser->parse($xmlstr);
+ ok($tree);
+}
+
+{
+ # Stream style
+ my $parser = XML::Parser->new(Style => 'Stream');
+ ok($parser);
+}
+
+{
+ # Subs style
+ my $parser = XML::Parser->new(Style => 'Subs');
+ ok($parser);
+}
+
+{
+ # Tree style
+ my $parser = XML::Parser->new(Style => 'Tree');
+ ok($parser);
+
+ my $tree = $parser->parse($xmlstr);
+ ok(ref($tree), 'ARRAY');
+ ok($tree->[0], 'foo');
+ ok(ref($tree->[1]), 'ARRAY');
+ ok(ref($tree->[1]->[0]), 'HASH');
+ ok($tree->[1][1], '0');
+ ok($tree->[1][2], 'bar');
+}
View Lorry Controller Status