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
123
124
125
126
127
128
129
130
131
132
133
|
#
# 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.
#
use strict;
package CheckAncestors;
use XML::DOM;
use Carp;
BEGIN
{
# import the constants for accessing member fields, e.g. _Doc
import XML::DOM::Node qw{ :Fields };
import XML::DOM::DocumentType qw{ :Fields };
}
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]);
}
}
# (This should have been called checkNamedNodeMap)
sub checkAttr
{
my ($self, $node, $attr) = @_;
return unless defined $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;
|
