1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
#
# Perl module for testing the XML::DOM module.
# Used by the test cases in the 't' directory.
# Recursively walks the node tree and checks parent/child and document links.
#
package CheckAncestors;
use XML::DOM;
use Carp;
sub new
{
my %args = (Mark => {});
bless \%args, $_[0];
}
sub check
{
my ($self, $node) = @_;
# check if node was already seen
croak "found Node twice [$node]" if ($self->{Mark}->{$node});
$self->{Mark}->{$node} = $node;
# check if document is correct
my $doc = $self->{Doc};
if (defined $doc)
{
my $doc2 = $node->{Doc};
croak "wrong Doc [$doc] [$doc2]" if $doc != $doc2;
}
else
{
$self->{Doc} = $doc;
}
# check if node's children know their parent
# and, recursively, check each kid
my $nodes = $node->getChildNodes;
if ($nodes)
{
for my $kid (@$nodes)
{
my $parent = $kid->getParentNode;
croak "wrong parent node=[$node] parent=[$parent]"
if ($parent != $node);
$self->check ($kid);
}
}
# check NamedNodeMaps
my $type = $node->getNodeType;
if ($type == XML::DOM::Node::ELEMENT_NODE ||
$type == XML::DOM::Node::ATTLIST_DECL_NODE)
{
$self->checkAttr ($node, $node->{A});
}
elsif ($type == XML::DOM::Node::DOCUMENT_TYPE_NODE)
{
$self->checkAttr ($node, $node->{Entities});
$self->checkAttr ($node, $node->{Notations});
}
}
sub checkAttr
{
my ($self, $node, $attr) = @_;
# check if NamedNodeMap was already seen
croak "found NamedNodeMap twice [$attr]" if ($self->{Mark}->{$attr});
$self->{Mark}->{$attr} = $attr;
# check if document is correct
my $doc = $self->{Doc};
if (defined $doc)
{
my $doc2 = $attr->getProperty ("Doc");
croak "wrong Doc [$doc] [$doc2]" if $doc != $doc2;
}
else
{
$self->{Doc} = $attr->getProperty ("Doc");
}
# check if NamedNodeMap knows his daddy
my $parent = $attr->getProperty ("Parent");
croak "wrong parent node=[$node] parent=[$parent]"
unless $node == $parent;
# check if NamedNodeMap's children know their parent
# and, recursively, check the child nodes
my $nodes = $attr->getValues;
if ($nodes)
{
for my $kid (@$nodes)
{
my $parent = $kid->{InUse};
croak "wrong InUse attr=[$attr] parent=[$parent]"
if ($parent != $attr);
$self->check ($kid);
}
}
}
sub doit
{
my $node = shift;
my $check = new CheckAncestors;
eval {
$check->check ($node);
};
if ($@)
{
print "checkAncestors failed:\n$@\n";
return 0;
}
return 1;
}
1;
|
