1#!./perl
2
3# $Id: dclone.t,v 0.18 2006/10/08 03:37:29 ray Exp $
4#
5# Id: dclone.t,v 0.6.1.1 2000/03/02 22:21:05 ram Exp 
6#
7#  Copyright (c) 1995-1998, Raphael Manfredi
8#  
9#  You may redistribute only under the terms of the Artistic License,
10#  as specified in the README file that comes with the distribution.
11#
12# $Log: dclone.t,v $
13# Revision 0.18  2006/10/08 03:37:29  ray
14# Commented out VERSION causes errors with DynaLoader in perl 5.6.1 (and
15# probably all earlier versions. It was removed.
16#
17# Revision 0.14  2003/09/07 22:02:36  ray
18# VERSION 0.15
19#
20# Revision 0.13.2.1  2003/09/07 21:51:13  ray
21# added support for unicode hash keys. This is only really a bug in 5.8.0 and
22# the test in t/03scalar supports this.
23#
24# Revision 0.13  2002/06/12 06:41:55  ray
25# VERSION 0.13
26#
27# Revision 0.11  2001/07/29 19:31:05  ray
28# VERSION 0.11
29#
30# Revision 0.10.2.1  2001/07/28 21:47:49  ray
31# commented out print statements.
32#
33# Revision 0.10  2001/04/29 21:56:10  ray
34# VERSION 0.10
35#
36# Revision 0.9  2001/03/05 00:11:49  ray
37# version 0.9
38#
39# Revision 0.9  2000/08/21 23:06:34  ray
40# added support for code refs
41#
42# Revision 0.8  2000/08/11 17:08:36  ray
43# Release 0.08.
44#
45# Revision 0.7  2000/08/01 00:31:42  ray
46# release 0.07
47#
48# Revision 0.6  2000/07/28 21:37:20  ray
49# "borrowed" code from Storable
50#
51# Revision 0.6.1.1  2000/03/02 22:21:05  ram
52# patch9: added test case for "undef" bug in hashes
53#
54# Revision 0.6  1998/06/04  16:08:25  ram
55# Baseline for first beta release.
56#
57
58require 't/dump.pl';
59
60# use Storable qw(dclone);
61use Clone qw(clone);
62
63print "1..9\n";
64
65$a = 'toto';
66$b = \$a;
67$c = bless {}, CLASS;
68$c->{attribute} = 'attrval';
69%a = ('key', 'value', 1, 0, $a, $b, 'cvar', \$c);
70@a = ('first', undef, 3, -4, -3.14159, 456, 4.5,
71	$b, \$a, $a, $c, \$c, \%a);
72
73print "not " unless defined ($aref = clone(\@a));
74print "ok 1\n";
75
76$dumped = &dump(\@a);
77print "ok 2\n";
78
79$got = &dump($aref);
80print "ok 3\n";
81
82# print $got;
83# print $dumped;
84# print $_, "\n" for (@a);
85# print $_, "\n" foreach (@$aref);
86print "not " unless $got eq $dumped; 
87print "ok 4\n";
88
89package FOO; @ISA = qw(Clone);
90
91sub make {
92	my $self = bless {};
93	$self->{key} = \%main::a;
94	return $self;
95};
96
97package main;
98
99$foo = FOO->make;
100print "not " unless defined($r = $foo->clone);
101print "ok 5\n";
102
103# print &dump($foo);
104# print &dump($r);
105print "not " unless &dump($foo) eq &dump($r);
106print "ok 6\n";
107
108# Ensure refs to "undef" values are properly shared during cloning
109my $hash;
110push @{$$hash{''}}, \$$hash{a};
111print "not " unless $$hash{''}[0] == \$$hash{a};
112print "ok 7\n";
113
114my $cloned = clone(clone($hash));
115print "not " unless $$cloned{''}[0] == \$$cloned{a};
116print "ok 8\n";
117
118$$cloned{a} = "blah";
119print "not " unless $$cloned{''}[0] == \$$cloned{a};
120print "ok 9\n";
121
122