Mercurial > pub > Impl
annotate _test/Test/DOM/Node.pm @ 250:129e48bb5afb
DOM refactoring
ObjectToDOM methods are virtual
QueryToDOM uses inflators
Fixed transform for the complex values in the ObjectToDOM
QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
| author | sergey |
|---|---|
| date | Wed, 07 Nov 2012 04:17:53 +0400 |
| parents | 4d0e1962161c |
| children | 99ac2e19c0cc |
| rev | line source |
|---|---|
| 49 | 1 package Test::DOM::Node; |
| 2 use strict; | |
| 3 use warnings; | |
| 4 | |
| 166 | 5 use parent qw(IMPL::Test::Unit); |
| 188 | 6 use IMPL::Test qw(test shared failed cmparray assert); |
| 49 | 7 use IMPL::Class::Property; |
| 188 | 8 use Scalar::Util qw(weaken); |
| 49 | 9 |
| 10 require IMPL::DOM::Node; | |
| 11 | |
| 12 __PACKAGE__->PassThroughArgs; | |
| 13 | |
| 14 BEGIN { | |
| 15 shared public property Root => prop_all; | |
| 16 } | |
| 17 | |
| 18 test Create => sub { | |
| 19 my ($this) = @_; | |
| 20 | |
| 21 $this->Root(new IMPL::DOM::Document(nodeName => 'Root')) or failed "Failed to create a document"; | |
| 22 }; | |
| 23 | |
| 24 test InsertNode => sub { | |
| 25 my ($this) = @_; | |
| 26 my $child = $this->Root->insertNode(new IMPL::DOM::Node(nodeName => 'Child')) or failed "Failed to insert a child node"; | |
| 27 failed "fiestChild returned incorrect results" unless ($this->Root->firstChild || 0) == $child; | |
| 28 }; | |
| 29 | |
| 30 test AppendNode => sub { | |
| 31 my ($this) = @_; | |
| 32 | |
| 33 my $child = $this->Root->appendNode(new IMPL::DOM::Node(nodeName => 'Child')) or failed "Failed to append a child node"; | |
| 34 | |
| 35 my $lastChild = $this->Root->removeLast; | |
| 36 | |
| 37 failed "removeLast returned incorrect results" unless $lastChild == $child; | |
| 38 }; | |
| 39 | |
| 40 test GetDocumentNode => sub { | |
| 41 my ($this) = @_; | |
| 42 | |
| 43 my $child = $this->Root->firstChild->appendNode(new IMPL::DOM::Node(nodeName => 'GrandChild')) or failed "Failed to append a child node"; | |
| 44 | |
| 45 failed "document property is undef" unless $child->document; | |
| 46 failed "document property returned incorrect value" unless $child->document == $this->Root; | |
| 47 }; | |
| 48 | |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
49 test DocumentCreateNode => sub { |
| 194 | 50 my ($this) = @_; |
| 51 | |
| 52 my $child = $this->Root->firstChild->appendNode($this->Root->Create(Info => { uuid => '77f9-9a-6d58' } )) or failed "Failed to append a child node"; | |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
53 |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
54 failed "document property is undef" unless $child->document; |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
55 failed "document property returned incorrect value" unless $child->document == $this->Root; |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
56 }; |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
57 |
| 49 | 58 test MoveNode => sub { |
| 59 my ($this) = @_; | |
| 60 | |
| 61 my $grandChild = $this->Root->firstChild->firstChild; | |
| 62 $this->Root->appendNode($grandChild); | |
| 63 | |
| 64 failed "incorrect new parentNode value" unless ($grandChild->parentNode || 0) == $this->Root; | |
| 65 failed "incorrect new document value" unless ($grandChild->document || 0) == $this->Root; | |
| 66 }; | |
| 67 | |
| 68 test AppendRange => sub { | |
| 69 my ($this) = @_; | |
| 70 | |
| 71 my $count = $this->Root->childNodes->Count; | |
| 72 | |
| 73 $this->Root->appendRange( | |
| 74 map IMPL::DOM::Node->new(nodeName => "Item", nodeValue => $_),1..10 | |
| 75 ); | |
| 76 | |
| 77 failed | |
| 78 "Wrong number of a child nodes", | |
| 79 "Expected: ".($count+10), | |
| 80 "Actual: ".$this->Root->childNodes->Count | |
| 81 unless $count + 10 == $this->Root->childNodes->Count; | |
| 82 }; | |
| 83 | |
| 84 test SelectNodes => sub { | |
| 85 my ($this) = @_; | |
| 86 | |
| 87 my @result = $this->Root->selectNodes("Item"); | |
| 88 | |
| 89 failed | |
| 90 "Wrong number of a selected nodes", | |
| 91 "Expected: 10", | |
| 92 "Actual: ".scalar(@result) | |
| 93 unless @result == 10; | |
| 94 }; | |
| 95 | |
| 96 test SelectNodesByQuery => sub { | |
| 97 my ($this) = @_; | |
| 98 | |
| 99 my @result = $this->Root->selectNodes(sub { $_->nodeName =~ /child/i } ); | |
| 100 failed | |
| 101 "Wrong number of a selected nodes", | |
| 102 "Expected: 2", | |
| 103 "Actual: ".scalar(@result) | |
| 104 unless @result == 2; | |
| 105 }; | |
| 106 | |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
107 test SelectNodesPath => sub { |
| 194 | 108 my ($this) = @_; |
| 109 | |
| 110 my @result = $this->Root->selectNodes('Child','Info'); | |
| 111 | |
| 112 failed "Failed to select a node by path 'Child/Info'" unless @result; | |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
113 }; |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
114 |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
115 test SelectByAxisDescendant => sub { |
| 194 | 116 my ($this) = @_; |
| 117 | |
| 118 my @result = $this->Root->selectNodes( { descendant => ['GrandChild','Info']} ); | |
| 119 | |
| 120 failed "Failed to select a node by path '//(GrandChild|Info)/'" unless @result == 2; | |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
121 }; |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
122 |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
123 test SelectByAxisAncestor => sub { |
| 194 | 124 my ($this) = @_; |
| 125 | |
| 126 my @result = $this->Root->selectSingleNode( { descendant => 'Info'} )->selectNodes( { ancestor => undef } ) ; | |
| 127 | |
| 128 failed "Failed to select a node by path '//Info/ancestor:*'" unless @result == 2; | |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
129 }; |
|
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
130 |
| 49 | 131 test CheckNodesValues => sub { |
| 132 my ($this) = @_; | |
| 133 | |
| 134 my @expected = (1..10); | |
| 135 | |
| 136 my @result = map $_->nodeValue, grep $_->nodeValue, $this->Root->selectNodes("Item"); | |
| 137 | |
| 138 failed | |
| 139 "Some nodes returned wrong node values or in a wrong order", | |
| 140 "Expected: ".join(', ',@expected), | |
| 141 "Recieved: ".join(', ',@result) | |
| 142 unless cmparray(\@expected,\@result); | |
| 143 | |
| 144 failed | |
| 145 "a text property of a root node returned a wrong value", | |
| 146 "Expected: @expected", | |
| 147 "Recieved: ". $this->Root->text | |
| 148 unless $this->Root->text eq join '',@expected; | |
| 149 }; | |
| 150 | |
| 151 test isComplex => sub { | |
| 152 my ($this) = @_; | |
| 153 | |
| 154 failed "property isComplex returned false for the root node" unless $this->Root->isComplex; | |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
124
diff
changeset
|
155 failed "property isComplex returned true for a simple node", $this->Root->selectSingleNode('Item')->childNodes->Count if $this->Root->selectSingleNode('Item')->isComplex; |
| 49 | 156 }; |
| 157 | |
| 123 | 158 test setObjectProperty => sub { |
| 194 | 159 my ($this) = @_; |
| 160 | |
| 161 my $node = Test::DOM::TypedNode->new(nodeName => 'TestNode'); | |
| 162 | |
| 163 my $name = 'Vergon 6'; | |
| 164 | |
| 165 $node->nodeProperty(name => $name); | |
| 166 failed "Failed to set a property 'name'", "Expected: $name", "Got: ".$node->name unless $node->name eq $name; | |
| 167 | |
| 168 $name = 'entity_vergon_6'; | |
| 169 $node->systemName($name); | |
| 170 failed "Failed to set a property 'systemName'", "Expected: $name", "Got: ".$node->nodeProperty('systemName') unless $node->nodeProperty('systemName') eq $name; | |
| 123 | 171 }; |
| 172 | |
| 173 test setDynamicProperty => sub { | |
| 194 | 174 my $node = Test::DOM::TypedNode->new(nodeName => 'TestNode'); |
| 175 | |
| 176 my $uuid = 'entity_76fd98b9e7a'; | |
| 177 $node->nodeProperty(uuid => $uuid); | |
| 178 failed "Failed to set a dynamic property 'uuid'", "Expected: $uuid", "Got: ".$node->nodeProperty('uuid') unless $node->nodeProperty('uuid') eq $uuid; | |
| 123 | 179 }; |
| 180 | |
| 181 test setPrivateProperty => sub { | |
| 194 | 182 my $node = Test::DOM::TypedNode->new(nodeName => 'TestNode'); |
| 183 | |
| 184 eval { | |
| 185 $node->nodeProperty(_private => 'failed'); | |
| 186 1; | |
| 187 } and failed "Setting a private property successfull"; | |
| 123 | 188 }; |
| 189 | |
| 124 | 190 test createNodeWithProps => sub { |
| 194 | 191 my $uuid = 'entity_76fd98b9e7a'; |
| 192 my $name = 'Vergon 6'; | |
| 193 my $systemName = 'entity_vergon_6'; | |
| 194 | |
| 195 my $node = Test::DOM::TypedNode->new( | |
| 196 nodeName => 'TestNode', | |
| 197 uuid => $uuid, | |
| 198 name => $name, | |
| 199 systemName => $systemName | |
| 200 ); | |
| 201 | |
| 202 failed "Failed to get dynamic property 'uuid'" unless $node->nodeProperty('uuid') eq $uuid; | |
| 203 failed "Failed to get property 'name' through nodeProperty method" unless $node->nodeProperty('name') eq $name; | |
| 204 failed "Failed to get property name directly" unless $node->name eq $name; | |
| 124 | 205 }; |
| 206 | |
| 207 test listNodePredefinedProps => sub { | |
| 194 | 208 my $node = Test::DOM::TypedNode->new(nodeName => 'TestNode'); |
| 209 | |
| 210 my @props = $node->listProperties; | |
| 211 my @expected = qw(name _private); | |
| 212 | |
| 213 failed "Got wrong list of props", @props unless cmparray(\@props,\@expected); | |
| 124 | 214 }; |
| 215 | |
| 216 test listNodeAllProps => sub { | |
| 194 | 217 my $node = Test::DOM::TypedNode->new( |
| 218 nodeName => 'TestNode', | |
| 219 uuid => 'ade58f98b', # dynamic | |
| 220 name => 'noname', # predefined | |
| 221 systemName => 'no sys' # not visible to DOM | |
| 222 ); | |
| 223 | |
| 224 my @props = $node->listProperties; | |
| 225 my @expected = qw(name _private uuid); # systemName is not a DOM prop | |
| 226 | |
| 227 failed "Got wrong list of props", @props unless cmparray(\@props,\@expected); | |
| 124 | 228 }; |
| 229 | |
| 188 | 230 test MemoryLeaks => sub { |
| 194 | 231 my $doc = new IMPL::DOM::Document(nodeName => 'Root'); |
| 232 weaken($doc); | |
| 233 | |
| 234 assert(not defined $doc); | |
| 188 | 235 }; |
| 236 | |
| 122 | 237 package Test::DOM::TypedNode; |
| 166 | 238 use parent qw(IMPL::DOM::Node); |
| 122 | 239 use IMPL::Class::Property; |
| 123 | 240 use IMPL::DOM::Property qw(_dom); |
| 241 | |
| 242 __PACKAGE__->PassThroughArgs; | |
| 122 | 243 |
| 123 | 244 BEGIN { |
| 194 | 245 public _dom property name => prop_all; |
| 246 public property systemName => prop_all; | |
| 247 private _dom property _private => prop_all; | |
| 123 | 248 } |
| 122 | 249 |
| 250 | |
| 49 | 251 1; |