File: 04_alias.t

package info (click to toggle)
libclass-ehierarchy-perl 2.01-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, sid, trixie
  • size: 280 kB
  • sloc: perl: 1,056; makefile: 2
file content (98 lines) | stat: -rw-r--r-- 3,180 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
# 04_alias.t
#
# Tests the tracking of object aliases

use Test::More tests => 46;

use strict;
use warnings;

use Class::EHierarchy;

sub dumpObjInfo {
    my $obj = shift;
    my ( $id, $parent, $children );

    $id       = $$obj;
    $parent   = defined $obj->parent ? ${ $obj->parent } : 'undef';
    $children = join ' ', map {$$_} $obj->children;

    warn "ID $id: P: $parent C: $children\n";
}

my $obj1 = new Class::EHierarchy;
my $obj2 = new Class::EHierarchy;
my $obj3 = new Class::EHierarchy;
my $obj4 = new Class::EHierarchy;

# pre-flight
ok( defined $obj1, 'instantiation 1' );
ok( defined $obj2, 'instantiation 2' );
ok( defined $obj3, 'instantiation 3' );
ok( defined $obj4, 'instantiation 4' );

# Pre-emptively apply aliases to 2 & 3
ok( $obj2->alias('o2'), 'alias 1' );
ok( $obj3->alias('o3'), 'alias 2' );

# Test realiasing
ok( !$obj3->alias('o33'), 'realias 1');

# Check pre-adoption aliases
is( $obj2->getByAlias('o2'), $obj2, 'pre-adoption alias 1');
is( $obj3->getByAlias('o3'), $obj3, 'pre-adoption alias 2');

# Build object hierarchy:
#   obj1 -> obj2 -> obj3, obj4
ok( $obj2->adopt( $obj3, $obj4 ), 'adopt 1' );
ok( $obj1->adopt($obj2), 'adopt 2' );

# Test realiasing
ok( !$obj3->alias('o33'), 'realias 2');

# Test inherited aliases via every object
is( $obj1->getByAlias('o2'), $obj2, 'get alias 1' );
is( $obj2->getByAlias('o2'), $obj2, 'get alias 2' );
is( $obj3->getByAlias('o2'), $obj2, 'get alias 3' );
is( $obj4->getByAlias('o2'), $obj2, 'get alias 4' );
is( $obj1->getByAlias('o3'), $obj3, 'get alias 5' );
is( $obj2->getByAlias('o3'), $obj3, 'get alias 6' );
is( $obj3->getByAlias('o3'), $obj3, 'get alias 7' );
is( $obj4->getByAlias('o3'), $obj3, 'get alias 8' );

# Test non-existent alias
is( $obj1->getByAlias('o1'), undef, 'get alias 9' );
is( $obj4->getByAlias(),     undef, 'get alias 10' );

# Alias o1 and o4
ok( $obj1->alias('o1'), 'alias 1' );
ok( $obj4->alias('o4'), 'alias 2' );

# Test new aliases via every object
is( $obj1->getByAlias('o1'), $obj1, 'get alias 11' );
is( $obj2->getByAlias('o1'), $obj1, 'get alias 12' );
is( $obj3->getByAlias('o1'), $obj1, 'get alias 13' );
is( $obj4->getByAlias('o1'), $obj1, 'get alias 14' );
is( $obj1->getByAlias('o4'), $obj4, 'get alias 15' );
is( $obj2->getByAlias('o4'), $obj4, 'get alias 16' );
is( $obj3->getByAlias('o4'), $obj4, 'get alias 17' );
is( $obj4->getByAlias('o4'), $obj4, 'get alias 18' );

# Disown o3 and test aliases again
ok( $obj2->disown($obj3), 'disown 1' );
is( $obj1->getByAlias('o3'), undef, 'get alias 19');
is( $obj4->getByAlias('o3'), undef, 'get alias 19');
is( $obj1->getByAlias('o2'), $obj2, 'get alias 20');
is( $obj4->getByAlias('o2'), $obj2, 'get alias 21');
is( $obj3->getByAlias('o1'), undef, 'get alias 22');
is( $obj3->getByAlias('o3'), $obj3, 'get alias 23');

# Disown o2 and test aliases
ok( $obj1->disown($obj2), 'disown 2');
is($obj1->getByAlias('o2'), undef, 'get alias 24');
is($obj1->getByAlias('o4'), undef, 'get alias 25');
is($obj1->getByAlias('o1'), $obj1, 'get alias 26');
is($obj2->getByAlias('o2'), $obj2, 'get alias 27');
is($obj2->getByAlias('o4'), $obj4, 'get alias 28');
is($obj4->getByAlias('o2'), $obj2, 'get alias 29');