Imported from /home/lorry/working-area/delta_perl-xml-parser/XML-Parser-2.36.tar.gz.HEADXML-Parser-2.36master

1 files changed, 264 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";
+