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