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]