]> git.sesse.net Git - xml-template/blobdiff - tests/xml-diff.pl
All xml-diff errors should be fatal.
[xml-template] / tests / xml-diff.pl
index ad1a2c7cce2eb6edfe9f4f275edf888c4295cff3..eed51b40c153a23a5956a24e4aca0e8fca02d414 100644 (file)
@@ -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,12 +58,36 @@ 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) {
                print STDERR "$nsuri1/$lname1 has differing number of children\n";
+               exit(1);
        }
 
        for my $i (0..($c1->getLength-1)) {
@@ -85,13 +113,14 @@ sub process_namespaces {
 }
 
 sub compare_attr_list {
-       my ($attrs1, $attrs2, $nsup1, $nsup2);
+       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 +130,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 +142,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);
                }
        }
 }