X-Git-Url: https://git.sesse.net/?a=blobdiff_plain;f=tests%2Fxml-diff.pl;h=517d9f7acc2e3d731aa8a26c0a031878b33147bc;hb=c1d4dfa5fe43d3e229cd90a18975fbf4df120f50;hp=5a59dd2738e748a4ffea7c9d978c9833c98606e0;hpb=39c6bd56806cfce0aa05e7c180fa050a3c853036;p=xml-template diff --git a/tests/xml-diff.pl b/tests/xml-diff.pl index 5a59dd2..517d9f7 100644 --- a/tests/xml-diff.pl +++ b/tests/xml-diff.pl @@ -5,11 +5,12 @@ # regression testing. # +use strict; +use warnings; + use XML::DOM; use XML::Parser; use XML::NamespaceSupport; -use Scalar::Util; -package XML::Template; my $parser = XML::DOM::Parser->new; my $d1 = $parser->parsefile($ARGV[0]); @@ -39,6 +40,9 @@ sub compare { my ($nsuri1, undef, $lname1) = $nsup1->process_element_name($n1->getNodeName); my ($nsuri2, undef, $lname2) = $nsup2->process_element_name($n2->getNodeName); + $nsuri1 |= ''; + $nsuri2 |= ''; + # compare element names unless ($nsuri1 eq $nsuri2 && $lname1 eq $lname2) { print STDERR "$nsuri1/$lname1 != $nsuri2/$lname2\n"; @@ -54,16 +58,60 @@ sub compare { compare_attr_list($attrs1, $attrs2, $nsup1, $nsup2) if (defined($attrs1)); compare_attr_list($attrs2, $attrs1, $nsup2, $nsup1) if (defined($attrs2)); + # if this is a text node, check the contents + if ($n1->getNodeType == XML::DOM::TEXT_NODE) { + my $d1 = $n1->getData; + my $d2 = $n2->getData; + + # ignore leading/trailing whitespace + $d1 =~ s/^\s+//; + $d2 =~ s/^\s+//; + $d1 =~ s/\s+$//; + $d2 =~ s/\s+$//; + + # compress other whitespace + $d1 =~ s/\n/ /g; + $d1 =~ s/ +/ /g; + $d2 =~ s/\n/ /g; + $d2 =~ s/ +/ /g; + + if ($d1 ne $d2) { + print STDERR "$nsuri1/$lname1 has differing textual content ('$d1' vs. '$d2')\n"; + exit(1); + } + } + # this element is ok, let's compare all children my $c1 = $n1->getChildNodes; my $c2 = $n2->getChildNodes; - if ($c1->getLength != $c2->getLength) { + my @c1 = (); + my @c2 = (); + + # find all elements except comments and blanks (not perfect, since we don't get + # compression, but ok) + for my $i (0..($c1->getLength-1)) { + my $item = $c1->item($i); + next if ($item->getNodeType == XML::DOM::COMMENT_NODE); + next if ($item->getNodeType == XML::DOM::TEXT_NODE && $item->getData !~ /\S/); + + push @c1, $item; + } + for my $i (0..($c2->getLength-1)) { + my $item = $c2->item($i); + next if ($item->getNodeType == XML::DOM::COMMENT_NODE); + next if ($item->getNodeType == XML::DOM::TEXT_NODE && $item->getData !~ /\S/); + + push @c2, $item; + } + + if (scalar @c1 != scalar @c2) { print STDERR "$nsuri1/$lname1 has differing number of children\n"; + exit(1); } - for my $i (0..($c1->getLength-1)) { - compare($c1->item($i), $c2->item($i), $nsup1, $nsup2); + for my $i (0..$#c1) { + compare($c1[$i], $c2[$i], $nsup1, $nsup2); } $nsup1->pop_context; @@ -88,10 +136,11 @@ sub compare_attr_list { my ($attrs1, $attrs2, $nsup1, $nsup2) = @_; for my $attr1 ($attrs1->getValues) { - my $name = $attr->getName; + my $name = $attr1->getName; next if ($name =~ /^xmlns:(.*)$/); - my ($nsuri1, undef, $lname1) = $nsup1->process_attribute_name($n1->getName); + my ($nsuri1, undef, $lname1) = $nsup1->process_attribute_name($attr1->getName); + $nsuri1 |= ''; if (!defined($attrs2)) { # n2 has no attributes at all @@ -101,7 +150,9 @@ sub compare_attr_list { my $attr2_found; for my $attr2 ($attrs2->getValues) { - my ($nsuri2, undef, $lname2) = $nsup2->process_attribute_name($n2->getName); + next if ($attr2->getName =~ /^xmlns:(.*)$/); + my ($nsuri2, undef, $lname2) = $nsup2->process_attribute_name($attr2->getName); + $nsuri2 |= ''; if ($nsuri1 eq $nsuri2 && $lname1 eq $lname2) { $attr2_found = $attr2; @@ -111,11 +162,12 @@ sub compare_attr_list { if (!defined($attr2_found)) { print STDERR "Attribute $nsuri1/$lname1 exists on one side but not the other\n"; - last; + exit(1); } - if ($attr1->getValue ne $attr2->getValue) { + if ($attr1->getValue ne $attr2_found->getValue) { print STDERR "Attribute $nsuri1/$lname1 has differing values\n"; + exit(1); } } }