Tarball conversion

17 files changed, 1236 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..9a240a6
--- /dev/null
+++ b/t/decl.t
@@ -0,0 +1,172 @@
+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});
+
+eval { $parser->parse($docstr) };
+if($@ && $^O =~ m/freebsd/i) {
+    for(2..30) {
+        print "not ok $_ - Cannot test due to Free BSD PR 157469 # TODO: Waiting for Free BSD fix in expat\n";
+    }
+    exit;
+}
+
+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..80ea681
--- /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 = XML::Parser->new(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 = XML::Parser->new(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..797bdf8
--- /dev/null
+++ b/t/parament.t
@@ -0,0 +1,123 @@
+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
+				 }
+		    );
+
+eval { $p->parse($doc) };
+if($@ && $^O =~ m/freebsd/i) {
+    for(2..12) {
+        print "not ok $_ - Cannot test due to Free BSD PR 157469 # TODO: Waiting for Free BSD fix in expat\n";
+    }
+    exit;
+}
+
+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');
+}