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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
#!/usr/bin/perl
use v5.14;
use warnings;
use Test::More;
use Test::Refcount;
use Tickit::Pen;
# Immutable pens
{
my $pen = Tickit::Pen::Immutable->new( fg => 3 );
isa_ok( $pen, "Tickit::Pen", '$pen isa Tickit::Pen' );
is( "$pen", "Tickit::Pen::Immutable{fg=3}", '"$pen"' );
is_deeply( { $pen->getattrs }, { fg => 3 }, '$pen attrs' );
ok( $pen->hasattr( 'fg' ), '$pen has fg' );
is( $pen->getattr( 'fg' ), 3, '$pen fg' );
ok( !$pen->hasattr( 'bg' ), '$pen has no bg' );
is( $pen->getattr( 'bg' ), undef, '$pen bg undef' );
ok( $pen->equiv( $pen ), '$pen is equiv to itself' );
ok( $pen->equiv( Tickit::Pen::Immutable->new( fg => 3 ) ), '$pen is equiv to another one the same' );
my $pen2 = Tickit::Pen::Immutable->new( fg => 3, b => 1 );
ok( $pen->equiv_attr( $pen2, 'fg' ), '$pen has equiv_attr fg another' );
ok( !$pen->equiv( $pen2 ), '$pen is not equiv to a different one' );
}
# Mutable pens
{
my $warnings = "";
local $SIG{__WARN__} = sub { $warnings .= join " ", @_ };
my $pen = Tickit::Pen::Mutable->new;
is( "$pen", "Tickit::Pen::Mutable{}", '"$pen" empty' );
is_deeply( { $pen->getattrs }, {}, '$pen initial attrs' );
ok( !$pen->hasattr( 'fg' ), '$pen initially lacks fg' );
is( $pen->getattr( 'fg' ), undef, '$pen fg initially undef' );
$pen->chattr( fg => 3 );
is_deeply( { $pen->getattrs }, { fg => 3 }, '$pen attrs after chattr' );
ok( $pen->hasattr( 'fg' ), '$pen now has fg' );
is( $pen->getattr( 'fg' ), 3, '$pen fg after chattr' );
is( "$pen", "Tickit::Pen::Mutable{fg=3}", '"$pen" after chattr' );
is_deeply( { $pen->as_mutable->getattrs }, { $pen->getattrs }, '$pen->as_mutable attrs' );
$pen->chattr( fg => "blue" );
is_deeply( { $pen->getattrs }, { fg => 4 }, '$pen attrs fg named' );
is( $pen->getattr( 'fg' ), 4, '$pen fg named' );
$pen->chattr( fg => "hi-blue" );
is_deeply( { $pen->getattrs }, { fg => 12 }, '$pen attrs fg named high-intensity' );
is( $pen->getattr( 'fg' ), 12, '$pen fg named high-intensity' );
$pen->delattr( 'fg' );
is_deeply( { $pen->getattrs }, {}, '$pen attrs after delattr' );
is( $pen->getattr( 'fg' ), undef, '$pen fg after delattr' );
my %attrs = ( b => 1, na => 5 );
$pen->chattrs( \%attrs );
is_deeply( { $pen->getattrs }, { b => 1 }, '$pen attrs after chattrs' );
is_deeply( \%attrs, { na => 5 }, '%attrs after chattrs' );
$pen->chattr( fg => "red" );
}
my $bluepen = Tickit::Pen::Immutable->new( fg => 4 );
my $otherpen = Tickit::Pen::Immutable->new( fg => 1, bg => 2 );
{
my $copy = $bluepen->as_mutable;
is_deeply( { $copy->copy_from( $otherpen )->getattrs },
{ fg => 1, bg => 2 },
'pen ->copy_from overwrites attributes' );
}
{
my $copy = $bluepen->as_mutable;
is_deeply( { $copy->default_from( $otherpen )->getattrs },
{ fg => 4, bg => 2 },
'pen ->default_from does not overwrite attributes' );
}
my $norv_pen = Tickit::Pen->new( rv => 0 );
$norv_pen->default_from( Tickit::Pen->new( rv => 1 ) );
is_deeply( { $norv_pen->getattrs },
{ rv => '' },
'pen ->default_from does not overwrite defined-but-false attributes' );
# RGB8 in pens
{
my $pen = Tickit::Pen->new(
fg => 15,
"fg:rgb8" => "#f0f0f0",
);
ok( $pen->hasattr( "fg:rgb8" ), '$pen has fg:rgb8' );
is( $pen->getattr( "fg:rgb8" ), "#F0F0F0", '$pen fg:rgb8 attr value' );
$pen->chattr( "fg:rgb8" => "#F1F2F3" );
is( $pen->getattr( "fg:rgb8" ), "#F1F2F3", '$pen fg:rgb8 attr new value' );
is_deeply( { $pen->getattrs },
{ fg => 15, "fg:rgb8" => "#F1F2F3" },
'$pen->getattrs' );
$pen->chattr( "fg:rgb8" => undef );
ok( !$pen->hasattr( "fg:rgb8" ), '$pen has no fg:rgb8' );
}
done_testing;
|
