1# $Id: 02hash.t,v 0.19 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..12\n"; } 11END {print "not ok 1\n" unless $loaded;} 12use Clone qw( clone ); 13use Data::Dumper; 14$loaded = 1; 15print "ok 1\n"; 16 17######################### End of black magic. 18 19# Insert your test code below (better if it prints "ok 13" 20# (correspondingly "not ok 13") depending on the success of chunk 13 21# of the test code): 22 23package Test::Hash; 24 25use vars @ISA; 26 27@ISA = qw(Clone); 28 29sub new 30 { 31 my $class = shift; 32 my %self = @_; 33 bless \%self, $class; 34 } 35 36sub DESTROY 37 { 38 my $self = shift; 39 # warn "DESTROYING $self"; 40 } 41 42package main; 43 44sub ok { print "ok $test\n"; $test++ } 45sub not_ok { print "not ok $test\n"; $test++ } 46 47$^W = 0; 48$test = 2; 49 50my $a = Test::Hash->new( 51 level => 1, 52 href => { 53 level => 2, 54 href => { 55 level => 3, 56 href => { 57 level => 4, 58 }, 59 }, 60 }, 61 ); 62 63$a->{a} = $a; 64 65my $b = $a->clone(0); 66my $c = $a->clone(3); 67 68$a->{level} == $b->{level} ? ok : not_ok; 69 70$b->{href} == $a->{href} ? ok : not_ok; 71$c->{href} != $a->{href} ? ok : not_ok; 72 73$b->{href}{href} == $a->{href}{href} ? ok : not_ok; 74$c->{href}{href} != $a->{href}{href} ? ok : not_ok; 75 76$c->{href}{href}{level} == 3 ? ok : not_ok; 77$c->{href}{href}{href}{level} == 4 ? ok : not_ok; 78 79$b->{href}{href}{href} == $a->{href}{href}{href} ? ok : not_ok; 80$c->{href}{href}{href} == $a->{href}{href}{href} ? ok : not_ok; 81 82my %circ = (); 83$circ{c} = \%circ; 84my $cref = clone(\%circ); 85Dumper(\%circ) eq Dumper($cref) ? ok : not_ok; 86 87# test for unicode support 88{ 89 my $a = { chr(256) => 1 }; 90 my $b = clone( $a ); 91 ord( (keys(%$a))[0] ) == ord( (keys(%$b))[0] ) ? ok : not_ok; 92} 93