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