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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 48;
## ----------------------------------------------------------------------------
# NOTE:
# This specifically tests the details of the cloning functions
## ----------------------------------------------------------------------------
use Tree::Simple;
my $tree = Tree::Simple->new(Tree::Simple->ROOT);
isa_ok($tree, 'Tree::Simple');
my $test = "test";
my $SCALAR_REF = \$test;
my $REF_TO_REF = \$SCALAR_REF;
my $ARRAY_REF = [ 1, 2, 3, 4 ];
my $HASH_REF = { one => 1, two => 2 };
my $CODE_REF = sub { "code ref test" };
my $REGEX_REF = qr/^reg-ex ref/;
my $SUB_TREE = Tree::Simple->new("sub tree test");
my $MISC_OBJECT = bless({}, "Misc");
$tree->addChildren(
Tree::Simple->new("non-ref"),
Tree::Simple->new($SCALAR_REF),
Tree::Simple->new($ARRAY_REF),
Tree::Simple->new($HASH_REF),
Tree::Simple->new($CODE_REF),
Tree::Simple->new($REGEX_REF),
Tree::Simple->new($MISC_OBJECT),
Tree::Simple->new($SUB_TREE),
Tree::Simple->new($REF_TO_REF)
);
my $clone = $tree->clone();
isa_ok($clone, 'Tree::Simple');
# make sure all the parentage is correct
is($clone->getParent(), Tree::Simple->ROOT, '... the clones parent is a root');
for my $child ($clone->getAllChildren()) {
is($child->getParent(), $clone, '... the clones childrens parent should be our clone');
}
isnt($clone, $tree, '... these should be refs');
is($clone->getChild(0)->getNodeValue(), $tree->getChild(0)->getNodeValue(), '... these should be the same value');
# they should both be scalar refs
is(ref($clone->getChild(1)->getNodeValue()), "SCALAR", '... these should be scalar refs');
is(ref($tree->getChild(1)->getNodeValue()), "SCALAR", '... these should be scalar refs');
# but different ones
isnt($clone->getChild(1)->getNodeValue(), $tree->getChild(1)->getNodeValue(),
'... these should be different scalar refs');
# with the same value
is(${$clone->getChild(1)->getNodeValue()}, ${$tree->getChild(1)->getNodeValue()},
'... these should be the same value');
# they should both be array refs
is(ref($clone->getChild(2)->getNodeValue()), "ARRAY", '... these should be array refs');
is(ref($tree->getChild(2)->getNodeValue()), "ARRAY", '... these should be array refs');
# but different ones
isnt($clone->getChild(2)->getNodeValue(), $tree->getChild(2)->getNodeValue(),
'... these should be different array refs');
# with the same value
is_deeply(
$clone->getChild(2)->getNodeValue(),
$tree->getChild(2)->getNodeValue(),
'... these should have the same contents');
# they should both be hash refs
is(ref($clone->getChild(3)->getNodeValue()), "HASH", '... these should be hash refs');
is(ref($tree->getChild(3)->getNodeValue()), "HASH", '... these should be hash refs');
# but different ones
isnt($clone->getChild(3)->getNodeValue(), $tree->getChild(3)->getNodeValue(),
'... these should be different hash refs');
# with the same value
is_deeply(
$clone->getChild(3)->getNodeValue(),
$tree->getChild(3)->getNodeValue(),
'... these should have the same contents');
# they should both be code refs
is(ref($clone->getChild(4)->getNodeValue()), "CODE", '... these should be code refs');
is(ref($tree->getChild(4)->getNodeValue()), "CODE", '... these should be code refs');
# and still the same
is($clone->getChild(4)->getNodeValue(), $tree->getChild(4)->getNodeValue(),
'... these should be the same code refs');
is($clone->getChild(4)->getNodeValue()->(), $CODE_REF->(), '... this is equal');
# they should both be reg-ex refs
is(ref($clone->getChild(5)->getNodeValue()), "Regexp", '... these should be reg-ex refs');
is(ref($tree->getChild(5)->getNodeValue()), "Regexp", '... these should be reg-ex refs');
# and still the same
is($clone->getChild(5)->getNodeValue(), $tree->getChild(5)->getNodeValue(),
'... these should be the same reg-ex refs');
# they should both be misc object refs
is(ref($clone->getChild(6)->getNodeValue()), "Misc", '... these should be misc object refs');
is(ref($tree->getChild(6)->getNodeValue()), "Misc", '... these should be misc object refs');
# and still the same
is($clone->getChild(6)->getNodeValue(), $tree->getChild(6)->getNodeValue(),
'... these should be the same misc object refs');
# they should both be Tree::Simple objects
is(ref($clone->getChild(7)->getNodeValue()), "Tree::Simple", '... these should be Tree::Simple');
is(ref($tree->getChild(7)->getNodeValue()), "Tree::Simple", '... these should be Tree::Simple');
# but different ones
isnt($clone->getChild(7)->getNodeValue(), $tree->getChild(7)->getNodeValue(),
'... these should be different Tree::Simple objects');
# with the same value
is($clone->getChild(7)->getNodeValue()->getNodeValue(), $tree->getChild(7)->getNodeValue()->getNodeValue(),
'... these should have the same contents');
# they should both be scalar refs
is(ref($clone->getChild(8)->getNodeValue()), "REF", '... these should be refs of refs');
is(ref($tree->getChild(8)->getNodeValue()), "REF", '... these should be refs of refs');
# but different ones
isnt($clone->getChild(8)->getNodeValue(), $tree->getChild(8)->getNodeValue(),
'... these should be different scalar refs');
# with the same ref value
is(${${$clone->getChild(8)->getNodeValue()}}, ${${$tree->getChild(8)->getNodeValue()}},
'... these should be the same value');
# test cloneShallow
my $shallow_clone = $tree->cloneShallow();
isnt($shallow_clone, $tree, '... these should be refs');
is_deeply(
[ $shallow_clone->getAllChildren() ],
[ $tree->getAllChildren() ],
'... the children are the same');
my $sub_tree = $tree->getChild(7);
my $sub_tree_clone = $sub_tree->cloneShallow();
# but different ones
isnt($sub_tree_clone->getNodeValue(), $sub_tree->getNodeValue(),
'... these should be different Tree::Simple objects');
# with the same value
is($sub_tree_clone->getNodeValue()->getNodeValue(), $sub_tree->getNodeValue()->getNodeValue(),
'... these should have the same contents');
|
