1# $Id: 04tie.t,v 0.18 2006/10/08 03:37:29 ray Exp $ 2# Before `make install' is performed this script should be runnable with 3# `make test'. After `make install' it should work as `perl test.pl' 4 5######################### We start with some black magic to print on failure. 6 7# Change 1..1 below to 1..last_test_to_print . 8# (It may become useful if the test is moved to ./t subdirectory.) 9 10BEGIN { $| = 1; print "1..5\n"; } 11END {print "not ok 1\n" unless $loaded;} 12use Clone qw( clone ); 13$loaded = 1; 14print "ok 1\n"; 15 16######################### End of black magic. 17 18my $test = 2; 19 20require 't/dump.pl'; 21require 't/tied.pl'; 22 23my ($a, @a, %a); 24tie $a, TIED_SCALAR; 25tie %a, TIED_HASH; 26tie @a, TIED_ARRAY; 27$a{a} = 0; 28$a{b} = 1; 29 30my $b = [\%a, \@a, \$a]; 31 32my $c = clone($b); 33 34my $d1 = &dump($b); 35my $d2 = &dump($c); 36 37print "not" unless $d1 eq $d2; 38print "ok ", $test++, "\n"; 39 40my $t1 = tied(%{$b->[0]}); 41my $t2 = tied(%{$c->[0]}); 42 43$d1 = &dump($t1); 44$d2 = &dump($t2); 45 46print "not" unless $d1 eq $d2; 47print "ok ", $test++, "\n"; 48 49$t1 = tied(@{$b->[1]}); 50$t2 = tied(@{$c->[1]}); 51 52$d1 = &dump($t1); 53$d2 = &dump($t2); 54 55print "not" unless $d1 eq $d2; 56print "ok ", $test++, "\n"; 57 58$t1 = tied(${$b->[2]}); 59$t2 = tied(${$c->[2]}); 60 61$d1 = &dump($t1); 62$d2 = &dump($t2); 63 64print "not" unless $d1 eq $d2; 65print "ok ", $test++, "\n"; 66 67