#! /usr/local/bin/perl -w use lib qw(./t); use strict; use Test_Framework; # Test the copy() method. The equals() method is used to # do much of the testing. use Class::Generate qw(&class); class Basic_Class => [ mem => '@', new => { style => 'positional mem' } ]; class All_Types => { Scalar => "\$", Array => '@', Hash => '%', Scalar_Class => 'Basic_Class', Array_Class => '@Basic_Class', Hash_Class => '%Basic_Class' }; use vars qw($v $w); $v = new All_Types; Test { $v = (new All_Types)->copy; ! grep defined $v->$_(), qw(Scalar Array Hash Scalar_Class Array_Class Hash_Class) }; Test { (new All_Types)->equals((new All_Types)->copy) }; Test { $v = (new All_Types Scalar => 1)->copy; $v->Scalar == 1 }; Test { (new All_Types Scalar => 1)->equals((new All_Types Scalar => 1)->copy) }; Test { my @a = (1, 2, 3); $v = (new All_Types Array => [@a])->copy; Arrays_Equal [$v->Array], [@a]; }; Test { my %h = (e1 => 1, e2 => 2); $v = (new All_Types Hash => {%h})->copy; Arrays_Equal [sort { $a cmp $b } $v->Hash], [sort { $a cmp $b } (%h)]; }; Test { my @a = (1, 2, 3); $v = (new All_Types Scalar_Class => (new Basic_Class [@a]))->copy; Arrays_Equal [$v->Scalar_Class->mem], [@a]; }; Test { my @a0 = (1, 2, 3); my @a1 = (4, 5, 6); $v = (new All_Types Array_Class => [(new Basic_Class [@a0]), (new Basic_Class [@a1])])->copy; ($v->Array_Class_size == 1 && Arrays_Equal([$v->Array_Class(0)->mem], [@a0]) && Arrays_Equal([$v->Array_Class(1)->mem], [@a1])); }; Test { my @a0 = (1, 2, 3); my @a1 = (4, 5, 6); $v = (new All_Types Hash_Class => { e1 => (new Basic_Class [@a0]), e2 => (new Basic_Class [@a1]) } )->copy; (scalar($v->Hash_Class_keys) == 2 && Arrays_Equal([sort { $a cmp $b } $v->Hash_Class_keys], [qw(e1 e2)]) && Arrays_Equal([$v->Hash_Class('e1')->mem], [@a0]) && Arrays_Equal([$v->Hash_Class('e2')->mem], [@a1])); }; Test { $v = new All_Types; $v->Scalar(1); $v->Array([2, 3]); $v->Hash({e1 => 3, e2 => 4}); $v->Scalar_Class(new Basic_Class [5, 6]); $v->Array_Class([(new Basic_Class [7]), (new Basic_Class [8])]); $v->Hash_Class({e1 => (new Basic_Class [7]), e2 => (new Basic_Class [8])}); $v->equals($v->copy); }; Test { class Picky_Copy => { Array => { type => '@', nocopy => 1 }, Hash => { type => '%', nocopy => 1 } }; 1; }; Test { $v = new Picky_Copy Array => [1, 2, 3], Hash => { e1 => 4, e2 => 5 }; $w = $v->copy; $v->equals($w) && $w->equals($v); }; Test { $v->Array(3, 4); $v->equals($w) }; Test { $v->Hash('e3', 6); $v->Hash('e1', 7); $v->delete_Hash('e2'); $v->equals($w); }; Report_Results;