You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@xerces.apache.org by ja...@apache.org on 2001/10/07 01:48:55 UTC

cvs commit: xml-xerces/perl/t DOMParser.t

jasons      01/10/06 16:48:55

  Modified:    perl/t   DOMParser.t
  Log:
  	* t/DOMParser.t (Repository):
  	Test for progressive parsing
  	Attempt to test reuse of a parser after a fatal progressive
  	   parse.
  	Test ignorable whitespace handling
  
  Revision  Changes    Path
  1.9       +99 -32    xml-xerces/perl/t/DOMParser.t
  
  Index: DOMParser.t
  ===================================================================
  RCS file: /home/cvs/xml-xerces/perl/t/DOMParser.t,v
  retrieving revision 1.8
  retrieving revision 1.9
  diff -u -r1.8 -r1.9
  --- DOMParser.t	2001/09/06 04:28:46	1.8
  +++ DOMParser.t	2001/10/06 23:48:55	1.9
  @@ -7,7 +7,7 @@
   # Change 1..1 below to 1..last_test_to_print .
   # (It may become useful if the test is moved to ./t subdirectory.)
   
  -BEGIN { $| = 1; print "1..5\n"; }
  +BEGIN { $| = 1; print "1..9\n"; }
   END {print "not ok 1\n" unless $loaded;}
   use Carp;
   use XML::Xerces;
  @@ -15,7 +15,7 @@
   
   use lib 't';
   use TestUtils qw(result $PERSONAL_FILE_NAME);
  -use vars qw($i $loaded $file);
  +use vars qw($i $loaded $file $error);
   use strict;
   
   $loaded = 1;
  @@ -36,46 +36,34 @@
   #   core dumps
   #
   
  -$file = '.domparsetest';
  -open(OUT,">$file")
  -  or die "Couldn't open $file for writing\n";
  -
  -print OUT <<'EOT';
  -use Carp;
  -use blib;
  -use XML::Xerces;
  -use Cwd;
  -
  -use lib 't';
  -use TestUtils qw($DOM);
  -
   package MyErrorHandler;
   use strict;
   use vars qw(@ISA);
   @ISA = qw(XML::Xerces::PerlErrorHandler);
  +sub warning {
  +}
   
  -sub fatal_error {sub exit(0);}
  +sub error {
  +  $::error = 'error';
  +}
   
  -package main;
  -{
  -  my $ERROR_HANDLER = MyErrorHandler->new();
  -  $DOM->setErrorHandler($ERROR_HANDLER);
  +sub fatal_error {
  +  $::error = 'fatal';
   }
  -# a bogus URL to cause a fatal error
  -my $URL = "file://../foo";
  -$DOM->parse(XML::Xerces::URLInputSource->new(XML::Xerces::XMLURL->new($URL)));
  -EOT
  -
  -# if we get an exit value of zero we succeeded
  -system("perl $file 2>/dev/null");
  -result(! $?);
  +1;
   
  -END {unlink $file;}
  +package main;
  +# a bogus URL to cause a fatal error
  +my $URL = 'file://../foo';
  +my $DOM = XML::Xerces::DOMParser->new();
  +$DOM->setErrorHandler(MyErrorHandler->new());
  +$error = undef;
  +$DOM->parse(XML::Xerces::URLInputSource->new('file:',$URL,'foo'));
  +result($error eq 'fatal');
   
   # test that our error handler generates a die() with a fatal error
  -my $DOM = XML::Xerces::DOMParser->new();
  -my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new();
  -$DOM->setErrorHandler($ERROR_HANDLER);
  +$DOM = XML::Xerces::DOMParser->new();
  +$DOM->setErrorHandler(XML::Xerces::PerlErrorHandler->new());
   eval "$DOM->parse(XML::Xerces::LocalFileInputSource->new('/I/AM/NOT/A/FILE'));";
   result($@);
   
  @@ -86,3 +74,82 @@
   # now test the overloaded methods in DOMParser
   $DOM->parse($PERSONAL_FILE_NAME);
   result(1);
  +
  +
  +# test the progressive parsing interface
  +my $token = XML::Xerces::XMLPScanToken->new();
  +$DOM->parseFirst($PERSONAL_FILE_NAME,$token);
  +while ($DOM->parseNext($token)) {
  +  # do nothing
  +}
  +result(1);
  +
  +
  +# test that we can reuse the parse again and again
  +my $document = <<\END;
  +<?xml version="1.0" encoding="iso-8859-1" standalone="no"?>
  +
  +<!-- @version: -->
  +<personnel>
  +
  +  <person id="Big.Boss">
  +    <name><family>Boss</family> <given>Big</given></name>
  +    <email>chief@foo.com</email>
  +    <link subordinates="one.worker two.worker three.worker four.worker five.worker"/>
  +  </person>
  +
  +  <person id="one.worker">
  +    <name><family>Worker</family> <given>One</given></name>
  +    <email>one@foo.com</email>
  +    <link manager="Big.Boss"/>
  +  </person>
  +
  +  <foo id="two.worker">
  +    <name><family>Worker</family> <given>Two</given></name>
  +    <email>two@foo.com</email>
  +    <link manager="Big.Boss"/>
  +  </person>
  +
  +  <person id="three.worker">
  +    <name><family>Worker</family> <given>Three</given></name>
  +    <email>three@foo.com</email>
  +    <link manager="Big.Boss"/>
  +  </person>
  +
  +  <person id="four.worker">
  +    <name><family>Worker</family> <given>Four</given></name>
  +    <email>four@foo.com</email>
  +    <link manager="Big.Boss"/>
  +  </person>
  +
  +  <person id="five.worker">
  +    <name><family>Worker</family> <given>Five</given></name>
  +    <email>five@foo.com</email>
  +    <link manager="Big.Boss"/>
  +  </person>
  +
  +</personnel>
  +END
  +
  +$token = XML::Xerces::XMLPScanToken->new();
  +$DOM->setErrorHandler(MyErrorHandler->new());
  +$::error = '';
  +$DOM->parseFirst(XML::Xerces::MemBufInputSource->new($document),$token);
  +while ($DOM->parseNext($token)) {
  +  # do nothing
  +}
  +result($::error eq 'fatal');
  +$::error = '';
  +$DOM->parseReset($token);
  +$DOM->parse(XML::Xerces::MemBufInputSource->new($document));
  +result($::error eq 'fatal');
  +
  +# test that we can exclude ignorable whitespace
  +$DOM = XML::Xerces::IDOMParser->new();
  +$DOM->setValidationScheme($XML::Xerces::DOMParser::Val_Always);
  +$DOM->setIncludeIgnorableWhitespace(0);
  +$DOM->parse($PERSONAL_FILE_NAME);
  +
  +# now check that we do *not* get whitespace nodes
  +my @nodes = $DOM->getDocument->getDocumentElement->getChildNodes();
  +result(scalar @nodes == 6);
  
  
  

---------------------------------------------------------------------
To unsubscribe, e-mail: xerces-cvs-unsubscribe@xml.apache.org
For additional commands, e-mail: xerces-cvs-help@xml.apache.org