jasons      2002/08/27 12:20:01

  Added:       perl/t   DOMAttr.t DOMDocument.t DOMElement.t DOMEntity.t
                        DOMException.t DOMNamedNodeMap.t DOMNode.t
                        DOMNodeIterator.t DOMNodeList.t DOMTreeWalker.t
                        DOMWriter.t
  Log:
  renamed old DOM_ tests
  
  Revision  Changes    Path
  1.1                  xml-xerces/perl/t/DOMAttr.t
  
  Index: DOMAttr.t
  ===================================================================
  # Before `make install' is performed this script should be runnable
  # with `make test'. After `make install' it should work as `perl
  # DOMAttr.t'
  
  ######################### 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 { $| = 1; print "1..6\n"; }
  END {print "not ok 1\n" unless $loaded;}
  use Carp;
  # use blib;
  use utf8;
  use XML::Xerces;
  
  use lib 't';
  use TestUtils qw(result is_object $DOM $PERSONAL_FILE_NAME);
  use vars qw($i $loaded);
  use strict;
  
  $loaded = 1;
  $i = 1;
  result($loaded);
  
  ######################### 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):
  
  eval{$DOM->parse($PERSONAL_FILE_NAME)};
  XML::Xerces::error($@) if $@;
  
  my $doc = $DOM->getDocument();
  my $doctype = $doc->getDoctype();
  my @persons = $doc->getElementsByTagName('person');
  result(is_object($persons[0])
         && $persons[0]->isa('XML::Xerces::DOMElement')
        );
  
  # test getting the attribute node
  my $attr = $persons[0]->getAttributeNode('id');
  result(is_object($attr)
         && $attr->isa('XML::Xerces::DOMAttr')
        );
  
  # test getting the attribute value
  result($attr->getValue() eq $persons[0]->getAttribute('id'));
  
  # test that we can use integers and floats as values for setting attribtes
  eval {$attr->setValue(3)};
  result(!$@);
  
  eval {$attr->setValue(.03)};
  result(!$@);
  
  
  
  1.1                  xml-xerces/perl/t/DOMDocument.t
  
  Index: DOMDocument.t
  ===================================================================
  # Before `make install' is performed this script should be runnable
  # with `make test'. After `make install' it should work as `perl
  # DOMDocument.t'
  
  ######################### 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 { $| = 1; print "1..35125\n"; }
  END {print "not ok 1\n" unless $loaded;}
  use Carp;
  
  # use blib;
  use utf8;
  use XML::Xerces;
  use Config;
  
  use lib 't';
  use TestUtils qw(result is_object);
  use vars qw($i $loaded);
  use strict;
  
  $loaded = 1;
  $i = 1;
  result($loaded);
  
  ######################### 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):
  
  # Create a couple of identical test documents
  my $document = q[<?xml version="1.0" encoding="UTF-8"?>
  <contributors>
        <person Role="manager">
                <name>Mike Pogue</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
        <person Role="developer">
                <name>Tom Watson</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
        <person Role="tech writer">
                <name>Susan Hardenbrook</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
  </contributors>];
  
  my $DOM1 = new XML::Xerces::XercesDOMParser;
  my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new();
  $DOM1->setErrorHandler($ERROR_HANDLER);
  $DOM1->parse(XML::Xerces::MemBufInputSource->new($document));
  
  my $DOM2 = new XML::Xerces::XercesDOMParser;
  $DOM2->setErrorHandler($ERROR_HANDLER);
  $DOM2->parse(XML::Xerces::MemBufInputSource->new($document, 'foo'));
  
  my $doc1 = $DOM1->getDocument();
  my $doc2 = $DOM2->getDocument();
  
  my $root1 = $doc1->getDocumentElement();
  my @persons1 = $doc1->getElementsByTagName('person');
  my @names1 = $doc1->getElementsByTagName('name');
  my $root2 = $doc2->getDocumentElement();
  my @persons2 = $doc2->getElementsByTagName('person');
  my @names2 = $doc1->getElementsByTagName('name');
  
  # importing a child from a different document
  eval {
    my $copy = $doc1->importNode($persons1[0],0);
    $root1->appendChild($copy);
  };
  result(!$@ &&
         scalar @persons1 < scalar ($root1->getElementsByTagName('person'))
        );
  
  # check that creating an element with an illegal charater
  eval {
    my $el = $doc1->createElement('?');
  };
  result($@
         && $@->{code} == $XML::Xerces::DOMException::INVALID_CHARACTER_ERR
        );
  
  # check that an element can't start with a digit
  eval {
    my $el = $doc1->createElement('9');
  };
  result($@
         && $@->{code} == $XML::Xerces::DOMException::INVALID_CHARACTER_ERR
        );
  
  # check that getElementById() doesn't segfault on undef ID
  eval {
    $doc1->getElementById(undef);
  };
  result($@);
  
  # check that an element can have a digit if a valid character comes first
  eval {
    $DOM1->parse('t/letter.xml');
  };
  if ($@) {
    if (ref($@)) {
      if ($@->isa('XML::Xerces::XMLException')) {
        die "Couldn't open letter.xml: ", $@->getMessage();
      } elsif ($@->isa('XML::Xerces::DOMException')) {
        die "Couldn't open letter.xml: msg=<$@->{msg}>, code=$@->{code}";
      }
    }
  }
  
  $doc1 = $DOM1->getDocument();
  my ($digit_node) = $doc1->getElementsByTagName('digit');
  my @digits;
  foreach my $range_node ($digit_node->getElementsByTagName('range')) {
    my $low = hex($range_node->getAttribute('low'));
    my $high = hex($range_node->getAttribute('high'));
    push(@digits,$low..$high);
  }
  foreach my $single_node ($digit_node->getElementsByTagName('single')) {
    my $value = hex($single_node->getAttribute('value'));
    push(@digits,$value);
  }
  @digits = map {chr($_)} @digits;
  foreach my $char (@digits) {
    eval {
      my $el = $doc1->createElement("_$char");
    };
    if ($@) {
      if (ref $@) {
        print STDERR "Error code: $@->{code}\n";
      } else {
        print STDERR $@;
      }
    }
    result(!$@) || printf("char: <0x%.4X>\n",ord($char));
  }
  
  my ($extender_node) = $doc1->getElementsByTagName('extender');
  my @extenders;
  foreach my $range_node ($extender_node->getElementsByTagName('range')) {
    my $low = hex($range_node->getAttribute('low'));
    my $high = hex($range_node->getAttribute('high'));
    push(@extenders,$low..$high);
  }
  foreach my $single_node ($extender_node->getElementsByTagName('single')) {
    my $value = hex($single_node->getAttribute('value'));
    push(@extenders,$value);
  }
  @extenders = map {chr($_)} @extenders;
  foreach my $char (@extenders) {
    eval {
      my $el = $doc1->createElement("_$char");
    };
    if ($@) {
      if (ref $@) {
        print STDERR "Error code: $@->{code}\n";
      } else {
        print STDERR $@;
      }
    }
    result(!$@) || printf("char: <0x%.4X>\n",ord($char));
  }
  
  my ($combining_char_node) = $doc1->getElementsByTagName('combiningchar');
  my @combining_chars;
  foreach my $range_node ($combining_char_node->getElementsByTagName('range')) {
    my $low = hex($range_node->getAttribute('low'));
    my $high = hex($range_node->getAttribute('high'));
    push(@combining_chars,$low..$high);
  }
  foreach my $single_node ($combining_char_node->getElementsByTagName('single')) {
    my $value = hex($single_node->getAttribute('value'));
    push(@combining_chars,$value);
  }
  @combining_chars = map {chr($_)} @combining_chars;
  foreach my $char (@combining_chars) {
    eval {
      my $el = $doc1->createElement("_$char");
    };
    if ($@) {
      if (ref $@) {
        print STDERR "Error code: $@->{code}\n";
      } else {
        print STDERR $@;
      }
    }
    result(!$@) || printf("char: <0x%.4X>\n",ord($char));
  }
  
  my ($letter_node) = $doc1->getElementsByTagName('letter');
  my @letters;
  foreach my $range_node ($letter_node->getElementsByTagName('range')) {
    my $low = hex($range_node->getAttribute('low'));
    my $high = hex($range_node->getAttribute('high'));
    push(@letters,$low..$high);
  }
  foreach my $single_node ($letter_node->getElementsByTagName('single')) {
    my $value = hex($single_node->getAttribute('value'));
    push(@letters,$value);
  }
  @letters = map {chr($_)} @letters;
  # $XML::Xerces::DEBUG_UTF8_IN = 1;
  # $XML::Xerces::DEBUG_UTF8_OUT = 1;
  foreach my $char (@letters) {
    eval {
      my $el = $doc1->createElement("$char");
    };
    if ($@) {
      if (ref $@) {
        print STDERR "Error code: $@->{code}\n";
      } else {
        print STDERR $@;
      }
    }
    result(!$@) || printf("char: <0x%.4X>\n",ord($char));
  }
  
  my ($ideograph_node) = $doc1->getElementsByTagName('ideographic');
  my @ideographs;
  foreach my $range_node ($ideograph_node->getElementsByTagName('range')) {
    my $low = hex($range_node->getAttribute('low'));
    my $high = hex($range_node->getAttribute('high'));
    push(@ideographs,$low..$high);
  }
  foreach my $single_node ($ideograph_node->getElementsByTagName('single')) {
    my $value = hex($single_node->getAttribute('value'));
    push(@ideographs,$value);
  }
  @ideographs = map {chr($_)} @ideographs;
  # $XML::Xerces::DEBUG_UTF8_IN = 1;
  # $XML::Xerces::DEBUG_UTF8_OUT = 1;
  foreach my $char (@ideographs) {
    eval {
      my $el = $doc1->createElement("$char");
    };
    if ($@) {
      if (ref $@) {
        print STDERR "Error code: $@->{code}\n";
      } else {
        print STDERR $@;
      }
    }
    result(!$@) || printf("char: <0x%.4X>\n",ord($char));
  }
  $XML::Xerces::DEBUG_UTF8_IN = 0;
  $XML::Xerces::DEBUG_UTF8_OUT = 0;
  
  # check that an element can start with an underscore
  eval {
    my $el = $doc1->createElement('_');
  };
  result(!$@);
  
  # check that an element can start with an colon
  eval {
    my $el = $doc1->createElement(':');
  };
  result(!$@);
  
  
  
  1.1                  xml-xerces/perl/t/DOMElement.t
  
  Index: DOMElement.t
  ===================================================================
  # Before `make install' is performed this script should be runnable
  # with `make test'. After `make install' it should work as `perl
  # DOMElement.t'
  
  ######################### 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 { $| = 1; print "1..4\n"; }
  END {print "not ok 1\n" unless $loaded;}
  use Carp;
  use XML::Xerces;
  
  use lib 't';
  use TestUtils qw(result $DOM $PERSONAL_FILE_NAME);
  use vars qw($i $loaded);
  use strict;
  
  $loaded = 1;
  $i = 1;
  result($loaded);
  
  ######################### 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):
  
  $DOM->parse($PERSONAL_FILE_NAME);
  
  my $doc = $DOM->getDocument();
  my $doctype = $doc->getDoctype();
  my @persons = $doc->getElementsByTagName('person');
  my @names = $doc->getElementsByTagName('name');
  
  # try to set an Attribute, 'foo', to undef
  result(!$persons[0]->setAttribute('foo',undef));
  
  # try to set an Attribute, undef, to 'foo'
  result(!$persons[0]->setAttribute(undef,'foo'));
  
  # ensure that actual_cast() is being called
  result(ref $persons[0] eq 'XML::Xerces::DOMElement');
  
  
  
  1.1                  xml-xerces/perl/t/DOMEntity.t
  
  Index: DOMEntity.t
  ===================================================================
  # Before `make install' is performed this script should be runnable
  # with `make test'. After `make install' it should work as `perl
  # DOMEntity.t'
  
  ######################### 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 { $| = 1; print "1..3\n"; }
  END {print "not ok 1\n" unless $loaded;}
  use Carp;
  # use blib;
  use XML::Xerces;
  
  use lib 't';
  use TestUtils qw(result $DOM);
  use vars qw($i $loaded);
  use strict;
  
  $loaded = 1;
  $i = 1;
  result($loaded);
  
  ######################### 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):
  
  my $document = <<'EOT';
  <?xml version="1.0" encoding="ISO-8859-1" standalone="yes"?>
  <!DOCTYPE foo [
  <!ENTITY data2    "DATA">
  <!ENTITY data   "DATA">
  <!ENTITY bar    "BAR">
  <!ELEMENT  foo        ANY>
  ]>
  <foo>This is a test &data; of entities</foo>
  EOT
  
  $DOM->setCreateEntityReferenceNodes(1);
  $DOM->setValidationScheme($XML::Xerces::AbstractDOMParser::Val_Never);
  my $is = eval{XML::Xerces::MemBufInputSource->new($document)};
  XML::Xerces::error($@) if $@;
  
  eval{$DOM->parse($is)};
  XML::Xerces::error($@) if $@;
  
  my $doc = $DOM->getDocument();
  my $doctype = $doc->getDoctype();
  
  # get the single <element> node
  my %ents = $doctype->getEntities();
  my $fail;
  result(exists $ents{data} && $ents{data} eq 'DATA', $fail=1);
  
  result(exists $ents{bar} && $ents{bar} eq 'BAR', $fail=1);
  
  
  
  1.6       +35 -31    xml-xerces/perl/t/DOMException.t
  
  
  
  
  1.1                  xml-xerces/perl/t/DOMNamedNodeMap.t
  
  Index: DOMNamedNodeMap.t
  ===================================================================
  # Before `make install' is performed this script should be runnable
  # with `make test'. After `make install' it should work as `perl
  # DOMNamedNodeMap.t'
  
  ######################### 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 { $| = 1; print "1..15\n"; }
  END {print "not ok 1\n" unless $loaded;}
  use Carp;
  use XML::Xerces;
  
  use lib 't';
  use TestUtils qw(result is_object $DOM);
  use vars qw($i $loaded);
  use strict;
  
  $loaded = 1;
  $i = 1;
  result($loaded);
  
  ######################### 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):
  
  my $document = <<EOT;
  <list>
    <element one='1' two='2' three='3'/>
    <none>text</none>
  </list>
  EOT
  
  $DOM->parse(XML::Xerces::MemBufInputSource->new($document));
  
  my $doc = $DOM->getDocument();
  
  # this tests a bug that getAttributes() should return an empty list
  # when there are no attributes (even when bogusly called on a text node)
  my ($element) = $doc->getElementsByTagName('none');
  my @attrs = $element->getFirstChild->getAttributes();
  result(scalar @attrs != 1);
  
  # get the single <element> node
  ($element) = $doc->getElementsByTagName('element');
  my %attrs = $element->getAttributes();
  result(scalar keys %attrs == 3 &&
         $attrs{one} == 1 &&
         $attrs{two} == 2 &&
         $attrs{three} == 3);
  
  # test that we can still get a DOMNodeList object
  # and test getLength()
  my $dom_node_map = $element->getAttributes();
  result(is_object($dom_node_map) 
        && $dom_node_map->isa('XML::Xerces::DOMNamedNodeMap')
        && $dom_node_map->getLength() == scalar keys %attrs
        );
  
  # test item()
  for (my $i=0;$i<scalar keys %attrs ;$i++) {
    my $node = $dom_node_map->item($i);
    result($attrs{$node->getNodeName} == $node->getNodeValue);
  }
  
  # test getNamedItem()
  foreach (keys %attrs) {
    result($dom_node_map->getNamedItem($_)->getNodeValue eq $attrs{$_});
  }
  
  # test setNamedItem()
  my $four = $doc->createAttribute('four');
  $four->setNodeValue('4');
  $dom_node_map->setNamedItem($four);
  result($dom_node_map->getNamedItem('four')->getNodeValue eq $four->getNodeValue);
  
  # test removeNamedItem()
  $dom_node_map->removeNamedItem('four');
  result($dom_node_map->getLength() == scalar keys %attrs);
  
  #
  # Test the DOM Level 2 methods
  # 
  my $uri = 'http://www.foo.bar/';
  $document = <<EOT;
  <list xmlns:qs="$uri">
    <element qs:one='1' qs:two='2' qs:three='3' one='27'/>
  </list>
  EOT
  
  $DOM->setDoNamespaces(1);
  $DOM->parse(XML::Xerces::MemBufInputSource->new($document));
  $doc = $DOM->getDocument();
  
  # get the single <element> node
  ($element) = $doc->getElementsByTagName('element');
  %attrs = $element->getAttributes();
  $dom_node_map = $element->getAttributes();
  
  # test getNamedItemNS()
  my $oneNS = $dom_node_map->getNamedItemNS($uri,'one');
  my $one = $dom_node_map->getNamedItem('one');
  result($one->getNodeValue eq '27'
         && $oneNS->getNodeValue eq '1'
        );
  
  # test setNamedItem()
  $four = $doc->createAttributeNS($uri,'four');
  $four->setNodeValue('4');
  $dom_node_map->setNamedItemNS($four);
  result($dom_node_map->getNamedItemNS($uri,'four')->getNodeValue eq 
$four->getNodeValue);
  
  # test removeNamedItem()
  $dom_node_map->removeNamedItemNS($uri,'four');
  result($dom_node_map->getLength() == scalar keys %attrs);
  
  
  
  
  1.1                  xml-xerces/perl/t/DOMNode.t
  
  Index: DOMNode.t
  ===================================================================
  # Before `make install' is performed this script should be runnable
  # with `make test'. After `make install' it should work as `perl
  # DOMNode.t'
  
  ######################### 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 { $| = 1; print "1..4\n"; }
  END {print "not ok 1\n" unless $loaded;}
  use Carp;
  
  use blib;
  use XML::Xerces;
  use Config;
  
  use lib 't';
  use TestUtils qw(result is_object);
  use vars qw($i $loaded);
  use strict;
  
  $loaded = 1;
  $i = 1;
  result($loaded);
  
  ######################### 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):
  
  # Create a couple of identical test documents
  my $document = q[<?xml version="1.0" encoding="UTF-8"?>
  <contributors>
        <person Role="manager">
                <name>Mike Pogue</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
        <person Role="developer">
                <name>Tom Watson</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
        <person Role="tech writer">
                <name>Susan Hardenbrook</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
  </contributors>];
  
  my $DOM1 = new XML::Xerces::XercesDOMParser;
  my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new();
  $DOM1->setErrorHandler($ERROR_HANDLER);
  my $is = eval{XML::Xerces::MemBufInputSource->new($document)};
  XML::Xerces::error($@) if $@;
  eval {$DOM1->parse($is)};
  XML::Xerces::error($@) if $@;
  
  my $DOM2 = new XML::Xerces::XercesDOMParser;
  $DOM2->setErrorHandler($ERROR_HANDLER);
  eval {$DOM2->parse(XML::Xerces::MemBufInputSource->new($document, 'foo'))};
  XML::Xerces::error($@) if $@;
  
  my $doc1 = $DOM1->getDocument();
  my $doc2 = $DOM2->getDocument();
  
  my $root1 = $doc1->getDocumentElement();
  my @persons1 = $doc1->getElementsByTagName('person');
  my @names1 = $doc1->getElementsByTagName('name');
  my $root2 = $doc2->getDocumentElement();
  my @persons2 = $doc2->getElementsByTagName('person');
  my @names2 = $doc1->getElementsByTagName('name');
  
  # importing a child from a different document
  eval {
    my $copy = $doc1->importNode($persons1[0],0);
    $root1->appendChild($copy);
  };
  result(!$@ &&
        scalar @persons1 < scalar ($root1->getElementsByTagName('person')));
  
  # test the equality operators
  my @people = $doc1->getElementsByTagName('person');
  result($root1 != $root2);
  result($people[0] == $persons1[0]);
  
  
  
  1.1                  xml-xerces/perl/t/DOMNodeIterator.t
  
  Index: DOMNodeIterator.t
  ===================================================================
  # Before `make install' is performed this script should be runnable
  # with `make test'. After `make install' it should work as `perl
  # DOMNodeIterator.t'
  
  ######################### 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 { $| = 1; print "1..5\n"; }
  END {print "not ok 1\n" unless $loaded;}
  use Carp;
  
  # use blib;
  use XML::Xerces;
  use Config;
  
  use lib 't';
  use TestUtils qw(result is_object);
  use vars qw($i $loaded);
  use strict;
  
  $loaded = 1;
  $i = 1;
  result($loaded);
  
  package MyNodeFilter;
  use strict;
  use vars qw(@ISA);
  @ISA = qw(XML::Xerces::PerlNodeFilter);
  sub acceptNode {
    my ($self,$node) = @_;
    return $XML::Xerces::DOMNodeFilter::FILTER_ACCEPT;
  }
  
  package main;
  
  ######################### 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):
  
  # Create a couple of identical test documents
  my $document = q[<?xml version="1.0" encoding="UTF-8"?>
  <contributors>
        <person Role="manager">
                <name>Mike Pogue</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
        <person Role="developer">
                <name>Tom Watson</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
        <person Role="tech writer">
                <name>Susan Hardenbrook</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
  </contributors>];
  
  my $DOM = new XML::Xerces::XercesDOMParser;
  my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new();
  $DOM->setErrorHandler($ERROR_HANDLER);
  $DOM->parse(XML::Xerces::MemBufInputSource->new($document));
  
  my $doc = $DOM->getDocument();
  my $root = $doc->getDocumentElement();
  my $filter = MyNodeFilter->new();
  my $what = $XML::Xerces::DOMNodeFilter::SHOW_ELEMENT;
  my $iterator = $doc->createNodeIterator($root,$what,$filter,1);
  result(defined $iterator
        and is_object($iterator)
        and $iterator->isa('XML::Xerces::DOMNodeIterator'));
  
  # test that nextNode() returns the first node in the set
  result($iterator->nextNode() == $root);
  
  my $success = 1;
  my $count = 0;
  while (my $node = $iterator->nextNode()) {
    $count++;
    $success = 0 unless $node->isa('XML::Xerces::DOMElement');
  }
  # test that we only got elements
  result($success);
  
  #test that we got all the elements
  result($count == 9);
  
  
  
  1.1                  xml-xerces/perl/t/DOMNodeList.t
  
  Index: DOMNodeList.t
  ===================================================================
  # Before `make install' is performed this script should be runnable with
  # `make test'. After `make install' it should work as `perl DOMNodeList.t'
  
  ######################### 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 { $| = 1; print "1..10\n"; }
  END {print "not ok 1\n" unless $loaded;}
  use Carp;
  use Cwd;
  # use blib;
  use XML::Xerces;
  
  use lib 't';
  use TestUtils qw(result $DOM $PERSONAL_FILE_NAME is_object);
  use vars qw($i $loaded);
  use strict;
  
  $loaded = 1;
  $i = 1;
  result($loaded);
  
  ######################### 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):
  
  $DOM->parse( new XML::Xerces::LocalFileInputSource($PERSONAL_FILE_NAME) );
  my $doc = $DOM->getDocument();
  
  # test automatic conversion to perl list
  my @node_list = $doc->getElementsByTagName('person');
  result(scalar @node_list == 6);
  
  # test that we can still get a DOMNodeList object
  my $dom_node_list = $doc->getElementsByTagName('person');
  result(is_object($dom_node_list) && 
         $dom_node_list->isa('XML::Xerces::DOMNodeList'));
  
  result($dom_node_list->getLength() == scalar @node_list);
  
  for (my $i=0;$i<scalar @node_list;$i++) {
    result($node_list[$i] == $dom_node_list->item($i));
  }
  
  
  
  1.1                  xml-xerces/perl/t/DOMTreeWalker.t
  
  Index: DOMTreeWalker.t
  ===================================================================
  # Before `make install' is performed this script should be runnable
  # with `make test'. After `make install' it should work as `perl
  # DOMNode.t'
  
  ######################### 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 { $| = 1; print "1..5\n"; }
  END {print "not ok 1\n" unless $loaded;}
  use Carp;
  
  use blib;
  use XML::Xerces;
  use Config;
  
  use lib 't';
  use TestUtils qw(result is_object);
  use vars qw($i $loaded);
  use strict;
  
  $loaded = 1;
  $i = 1;
  result($loaded);
  
  package MyNodeFilter;
  use strict;
  use vars qw(@ISA);
  @ISA = qw(XML::Xerces::PerlNodeFilter);
  sub acceptNode {
    my ($self,$node) = @_;
    return $XML::Xerces::DOMNodeFilter::FILTER_ACCEPT;
  }
  
  package main;
  
  ######################### 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):
  
  # Create a couple of identical test documents
  my $document = q[<?xml version="1.0" encoding="UTF-8"?>
  <contributors>
        <person Role="manager">
                <name>Mike Pogue</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
        <person Role="developer">
                <name>Tom Watson</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
        <person Role="tech writer">
                <name>Susan Hardenbrook</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
  </contributors>];
  
  my $DOM = new XML::Xerces::XercesDOMParser;
  my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new();
  $DOM->setErrorHandler($ERROR_HANDLER);
  $DOM->parse(XML::Xerces::MemBufInputSource->new($document));
  
  my $doc = $DOM->getDocument();
  my $root = $doc->getDocumentElement();
  my $filter = MyNodeFilter->new();
  my $what = $XML::Xerces::DOMNodeFilter::SHOW_ELEMENT;
  my $walker = $doc->createTreeWalker($root,$what,$filter,1);
  result(defined $walker
        and is_object($walker)
        and $walker->isa('XML::Xerces::DOMTreeWalker'));
  
  # test parentNode
  $walker->nextNode();
  result($walker->parentNode() == $root);
  
  my $success = 1;
  my $count = 0;
  while (my $node = $walker->nextNode()) {
    $count++;
    $success = 0 unless $node->isa('XML::Xerces::DOMElement');
  }
  # test that we only got elements
  result($success);
  
  #test that we got all the elements
  result($count == 9);
  
  
  
  1.1                  xml-xerces/perl/t/DOMWriter.t
  
  Index: DOMWriter.t
  ===================================================================
  # Before `make install' is performed this script should be runnable
  # with `make test'. After `make install' it should work as `perl
  # DOMWriter.t'
  
  ######################### 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 { $| = 1; print "1..5\n"; }
  END {print "not ok 1\n" unless $loaded;}
  use Carp;
  
  use blib;
  use XML::Xerces;
  use Config;
  
  use lib 't';
  use TestUtils qw(result is_object);
  use vars qw($i $loaded);
  use strict;
  
  $loaded = 1;
  $i = 1;
  result($loaded);
  
  ######################### 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):
  
  # Create a couple of identical test documents
  my $document = q[<?xml version="1.0" encoding="UTF-8"?>
  <contributors>
        <person Role="manager">
                <name>Mike Pogue</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
        <person Role="developer">
                <name>Tom Watson</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
        <person Role="tech writer">
                <name>Susan Hardenbrook</name>
                <email>[EMAIL PROTECTED]</email>
        </person>
  </contributors>];
  
  my $dom = XML::Xerces::XercesDOMParser->new();
  my $impl = XML::Xerces::DOMImplementationRegistry::getDOMImplementation('LS');
  my $writer = $impl->createDOMWriter();
  # $writer->setNewLine(0);
  # $writer->setEncoding(0);
  my $handler = XML::Xerces::PerlErrorHandler->new();
  $dom->setErrorHandler($handler);
  eval{$dom->parse(XML::Xerces::MemBufInputSource->new($document))};
  XML::Xerces::error($@) if $@;
  
  my $target = XML::Xerces::MemBufFormatTarget->new();
  my $doc = $dom->getDocument();
  $writer->writeNode($target,$doc);
  my $output = $target->getString();
  result($output);
  print STDERR "$output\n";
  
  
  

---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]

Reply via email to