1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use Test::More tests => 48; 7 8## ---------------------------------------------------------------------------- 9# NOTE: 10# This specifically tests the details of the cloning functions 11## ---------------------------------------------------------------------------- 12 13use Tree::Simple; 14 15my $tree = Tree::Simple->new(Tree::Simple->ROOT); 16isa_ok($tree, 'Tree::Simple'); 17 18my $test = "test"; 19 20my $SCALAR_REF = \$test; 21my $REF_TO_REF = \$SCALAR_REF; 22my $ARRAY_REF = [ 1, 2, 3, 4 ]; 23my $HASH_REF = { one => 1, two => 2 }; 24my $CODE_REF = sub { "code ref test" }; 25my $REGEX_REF = qr/^reg-ex ref/; 26my $SUB_TREE = Tree::Simple->new("sub tree test"); 27my $MISC_OBJECT = bless({}, "Misc"); 28 29$tree->addChildren( 30 Tree::Simple->new("non-ref"), 31 Tree::Simple->new($SCALAR_REF), 32 Tree::Simple->new($ARRAY_REF), 33 Tree::Simple->new($HASH_REF), 34 Tree::Simple->new($CODE_REF), 35 Tree::Simple->new($REGEX_REF), 36 Tree::Simple->new($MISC_OBJECT), 37 Tree::Simple->new($SUB_TREE), 38 Tree::Simple->new($REF_TO_REF) 39 ); 40 41my $clone = $tree->clone(); 42isa_ok($clone, 'Tree::Simple'); 43 44# make sure all the parentage is correct 45is($clone->getParent(), Tree::Simple->ROOT, '... the clones parent is a root'); 46 47for my $child ($clone->getAllChildren()) { 48 is($child->getParent(), $clone, '... the clones childrens parent should be our clone'); 49} 50 51isnt($clone, $tree, '... these should be refs'); 52 53is($clone->getChild(0)->getNodeValue(), $tree->getChild(0)->getNodeValue(), '... these should be the same value'); 54 55# they should both be scalar refs 56is(ref($clone->getChild(1)->getNodeValue()), "SCALAR", '... these should be scalar refs'); 57is(ref($tree->getChild(1)->getNodeValue()), "SCALAR", '... these should be scalar refs'); 58# but different ones 59isnt($clone->getChild(1)->getNodeValue(), $tree->getChild(1)->getNodeValue(), 60 '... these should be different scalar refs'); 61# with the same value 62is(${$clone->getChild(1)->getNodeValue()}, ${$tree->getChild(1)->getNodeValue()}, 63 '... these should be the same value'); 64 65# they should both be array refs 66is(ref($clone->getChild(2)->getNodeValue()), "ARRAY", '... these should be array refs'); 67is(ref($tree->getChild(2)->getNodeValue()), "ARRAY", '... these should be array refs'); 68# but different ones 69isnt($clone->getChild(2)->getNodeValue(), $tree->getChild(2)->getNodeValue(), 70 '... these should be different array refs'); 71# with the same value 72is_deeply( 73 $clone->getChild(2)->getNodeValue(), 74 $tree->getChild(2)->getNodeValue(), 75 '... these should have the same contents'); 76 77# they should both be hash refs 78is(ref($clone->getChild(3)->getNodeValue()), "HASH", '... these should be hash refs'); 79is(ref($tree->getChild(3)->getNodeValue()), "HASH", '... these should be hash refs'); 80# but different ones 81isnt($clone->getChild(3)->getNodeValue(), $tree->getChild(3)->getNodeValue(), 82 '... these should be different hash refs'); 83# with the same value 84is_deeply( 85 $clone->getChild(3)->getNodeValue(), 86 $tree->getChild(3)->getNodeValue(), 87 '... these should have the same contents'); 88 89# they should both be code refs 90is(ref($clone->getChild(4)->getNodeValue()), "CODE", '... these should be code refs'); 91is(ref($tree->getChild(4)->getNodeValue()), "CODE", '... these should be code refs'); 92# and still the same 93is($clone->getChild(4)->getNodeValue(), $tree->getChild(4)->getNodeValue(), 94 '... these should be the same code refs'); 95is($clone->getChild(4)->getNodeValue()->(), $CODE_REF->(), '... this is equal'); 96 97# they should both be reg-ex refs 98is(ref($clone->getChild(5)->getNodeValue()), "Regexp", '... these should be reg-ex refs'); 99is(ref($tree->getChild(5)->getNodeValue()), "Regexp", '... these should be reg-ex refs'); 100# and still the same 101is($clone->getChild(5)->getNodeValue(), $tree->getChild(5)->getNodeValue(), 102 '... these should be the same reg-ex refs'); 103 104# they should both be misc object refs 105is(ref($clone->getChild(6)->getNodeValue()), "Misc", '... these should be misc object refs'); 106is(ref($tree->getChild(6)->getNodeValue()), "Misc", '... these should be misc object refs'); 107# and still the same 108is($clone->getChild(6)->getNodeValue(), $tree->getChild(6)->getNodeValue(), 109 '... these should be the same misc object refs'); 110 111# they should both be Tree::Simple objects 112is(ref($clone->getChild(7)->getNodeValue()), "Tree::Simple", '... these should be Tree::Simple'); 113is(ref($tree->getChild(7)->getNodeValue()), "Tree::Simple", '... these should be Tree::Simple'); 114# but different ones 115isnt($clone->getChild(7)->getNodeValue(), $tree->getChild(7)->getNodeValue(), 116 '... these should be different Tree::Simple objects'); 117# with the same value 118is($clone->getChild(7)->getNodeValue()->getNodeValue(), $tree->getChild(7)->getNodeValue()->getNodeValue(), 119 '... these should have the same contents'); 120 121# they should both be scalar refs 122is(ref($clone->getChild(8)->getNodeValue()), "REF", '... these should be refs of refs'); 123is(ref($tree->getChild(8)->getNodeValue()), "REF", '... these should be refs of refs'); 124# but different ones 125isnt($clone->getChild(8)->getNodeValue(), $tree->getChild(8)->getNodeValue(), 126 '... these should be different scalar refs'); 127# with the same ref value 128is(${${$clone->getChild(8)->getNodeValue()}}, ${${$tree->getChild(8)->getNodeValue()}}, 129 '... these should be the same value'); 130 131# test cloneShallow 132 133my $shallow_clone = $tree->cloneShallow(); 134 135isnt($shallow_clone, $tree, '... these should be refs'); 136 137is_deeply( 138 [ $shallow_clone->getAllChildren() ], 139 [ $tree->getAllChildren() ], 140 '... the children are the same'); 141 142my $sub_tree = $tree->getChild(7); 143my $sub_tree_clone = $sub_tree->cloneShallow(); 144# but different ones 145isnt($sub_tree_clone->getNodeValue(), $sub_tree->getNodeValue(), 146 '... these should be different Tree::Simple objects'); 147# with the same value 148is($sub_tree_clone->getNodeValue()->getNodeValue(), $sub_tree->getNodeValue()->getNodeValue(), 149 '... these should have the same contents'); 150 151