1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use Test::More tests => 36; 7use Test::Exception; 8 9BEGIN { 10 use_ok('Tree::Simple::Visitor::VariableDepthClone'); 11} 12 13use Tree::Simple; 14use Tree::Simple::Visitor::PreOrderTraversal; 15 16my $tree = Tree::Simple->new(Tree::Simple->ROOT) 17 ->addChildren( 18 Tree::Simple->new("1") 19 ->addChildren( 20 Tree::Simple->new("1.1"), 21 Tree::Simple->new("1.2") 22 ->addChildren( 23 Tree::Simple->new("1.2.1"), 24 Tree::Simple->new("1.2.2") 25 ), 26 Tree::Simple->new("1.3") 27 ), 28 Tree::Simple->new("2") 29 ->addChildren( 30 Tree::Simple->new("2.1"), 31 Tree::Simple->new("2.2") 32 ), 33 Tree::Simple->new("3") 34 ->addChildren( 35 Tree::Simple->new("3.1"), 36 Tree::Simple->new("3.2"), 37 Tree::Simple->new("3.3") 38 ), 39 Tree::Simple->new("4") 40 ->addChildren( 41 Tree::Simple->new("4.1") 42 ) 43 ); 44isa_ok($tree, 'Tree::Simple'); 45 46can_ok("Tree::Simple::Visitor::VariableDepthClone", 'new'); 47 48{ 49 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 50 isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); 51 isa_ok($visitor, 'Tree::Simple::Visitor'); 52 53 can_ok($visitor, 'setCloneDepth'); 54 can_ok($visitor, 'getClone'); 55 56 $visitor->setCloneDepth(2); 57 58 $tree->accept($visitor); 59 60 my $cloned = $visitor->getClone(); 61 62 my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); 63 $cloned->accept($checker); 64 is_deeply( 65 [ $checker->getResults() ], 66 [ qw(1 1.1 1.2 1.3 2 2.1 2.2 3 3.1 3.2 3.3 4 4.1) ], 67 '... our results are as expected'); 68} 69 70{ 71 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 72 isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); 73 74 $visitor->setCloneDepth(1); 75 $visitor->setNodeFilter(sub { 76 my ($old, $new) = @_; 77 $new->setNodeValue($old->getNodeValue() . "new"); 78 }); 79 $tree->accept($visitor); 80 81 my $cloned = $visitor->getClone(); 82 83 my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); 84 $cloned->accept($checker); 85 is_deeply( 86 [ $checker->getResults() ], 87 [ qw(1new 2new 3new 4new) ], 88 '... our results are as expected'); 89} 90 91{ 92 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 93 isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); 94 95 $visitor->setCloneDepth(3); 96 97 $tree->accept($visitor); 98 99 my $cloned = $visitor->getClone(); 100 101 my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); 102 $cloned->accept($checker); 103 is_deeply( 104 [ $checker->getResults() ], 105 [ qw(1 1.1 1.2 1.2.1 1.2.2 1.3 2 2.1 2.2 3 3.1 3.2 3.3 4 4.1) ], 106 '... our results are as expected'); 107} 108 109{ 110 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 111 isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); 112 113 $visitor->setCloneDepth(100); 114 115 $tree->accept($visitor); 116 117 my $cloned = $visitor->getClone(); 118 119 my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); 120 $cloned->accept($checker); 121 is_deeply( 122 [ $checker->getResults() ], 123 [ qw(1 1.1 1.2 1.2.1 1.2.2 1.3 2 2.1 2.2 3 3.1 3.2 3.3 4 4.1) ], 124 '... our results are as expected'); 125} 126 127{ 128 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 129 isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); 130 131 $visitor->setCloneDepth(0); 132 133 $tree->accept($visitor); 134 135 my $cloned = $visitor->getClone(); 136 137 my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); 138 $cloned->accept($checker); 139 is_deeply( 140 [ $checker->getResults() ], 141 [], 142 '... our results are as expected'); 143} 144 145{ 146 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 147 isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); 148 149 $visitor->setCloneDepth(-1); 150 151 $tree->accept($visitor); 152 153 my $cloned = $visitor->getClone(); 154 155 my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); 156 $cloned->accept($checker); 157 is_deeply( 158 [ $checker->getResults() ], 159 [], 160 '... our results are as expected'); 161} 162 163{ 164 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 165 isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); 166 167 $visitor->setCloneDepth(-100); 168 169 $tree->accept($visitor); 170 171 my $cloned = $visitor->getClone(); 172 173 my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); 174 $cloned->accept($checker); 175 is_deeply( 176 [ $checker->getResults() ], 177 [], 178 '... our results are as expected'); 179} 180 181# check with trunk 182 183{ 184 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 185 isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); 186 187 $visitor->includeTrunk(1); 188 $visitor->setCloneDepth(2); 189 $visitor->setNodeFilter(sub { 190 my ($old, $new) = @_; 191 $new->setNodeValue($old->getNodeValue() . "new"); 192 }); 193 194 $tree->getChild(0)->accept($visitor); 195 196 my $cloned = $visitor->getClone(); 197 198 my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); 199 $cloned->accept($checker); 200 is_deeply( 201 [ $checker->getResults() ], 202 [ qw(1new 1.1new 1.2new 1.2.1new 1.2.2new 1.3new) ], 203 '... our results are as expected'); 204} 205 206{ 207 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 208 isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); 209 210 $visitor->includeTrunk(1); 211 $visitor->setCloneDepth(1); 212 213 $tree->getChild(0)->accept($visitor); 214 215 my $cloned = $visitor->getClone(); 216 217 my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); 218 $cloned->accept($checker); 219 is_deeply( 220 [ $checker->getResults() ], 221 [ qw(1 1.1 1.2 1.3) ], 222 '... our results are as expected'); 223} 224 225{ 226 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 227 isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); 228 229 $visitor->includeTrunk(1); 230 $visitor->setCloneDepth(0); 231 232 $tree->getChild(0)->accept($visitor); 233 234 my $cloned = $visitor->getClone(); 235 236 my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); 237 $cloned->accept($checker); 238 is_deeply( 239 [ $checker->getResults() ], 240 [ qw(1) ], 241 '... our results are as expected'); 242} 243 244{ 245 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 246 isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); 247 248 $visitor->includeTrunk(1); 249 $visitor->setCloneDepth(-1); 250 251 $tree->getChild(0)->accept($visitor); 252 253 my $cloned = $visitor->getClone(); 254 255 my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); 256 $cloned->accept($checker); 257 is_deeply( 258 [ $checker->getResults() ], 259 [ qw(1) ], 260 '... our results are as expected'); 261} 262 263{ 264 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 265 isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); 266 267 $visitor->includeTrunk(1); 268 $visitor->setCloneDepth(-100); 269 270 $tree->getChild(0)->getChild(0)->accept($visitor); 271 272 my $cloned = $visitor->getClone(); 273 274 my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); 275 $cloned->accept($checker); 276 is_deeply( 277 [ $checker->getResults() ], 278 [ qw(1.1) ], 279 '... our results are as expected'); 280} 281 282# check some errors 283 284# check errors 285{ 286 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 287 isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); 288 289 # check visit 290 throws_ok { 291 $visitor->visit(); 292 } qr/Insufficient Arguments/, '... got the error we expected'; 293 294 throws_ok { 295 $visitor->visit("Fail"); 296 } qr/Insufficient Arguments/, '... got the error we expected'; 297 298 throws_ok { 299 $visitor->visit([]); 300 } qr/Insufficient Arguments/, '... got the error we expected'; 301 302 throws_ok { 303 $visitor->visit(bless({}, "Fail")); 304 } qr/Insufficient Arguments/, '... got the error we expected'; 305 306 throws_ok { 307 $visitor->setCloneDepth(); 308 } qr/Insufficient Arguments/, '... got the error we expected'; 309 310} 311