1#!/usr/bin/perl 2 3use v5.14; 4use warnings; 5 6use Test::More; 7use Test::Refcount; 8 9use Tickit::Pen; 10 11# Immutable pens 12{ 13 my $pen = Tickit::Pen::Immutable->new( fg => 3 ); 14 15 isa_ok( $pen, "Tickit::Pen", '$pen isa Tickit::Pen' ); 16 17 is( "$pen", "Tickit::Pen::Immutable{fg=3}", '"$pen"' ); 18 19 is_deeply( { $pen->getattrs }, { fg => 3 }, '$pen attrs' ); 20 21 ok( $pen->hasattr( 'fg' ), '$pen has fg' ); 22 is( $pen->getattr( 'fg' ), 3, '$pen fg' ); 23 24 ok( !$pen->hasattr( 'bg' ), '$pen has no bg' ); 25 is( $pen->getattr( 'bg' ), undef, '$pen bg undef' ); 26 27 ok( $pen->equiv( $pen ), '$pen is equiv to itself' ); 28 ok( $pen->equiv( Tickit::Pen::Immutable->new( fg => 3 ) ), '$pen is equiv to another one the same' ); 29 30 my $pen2 = Tickit::Pen::Immutable->new( fg => 3, b => 1 ); 31 32 ok( $pen->equiv_attr( $pen2, 'fg' ), '$pen has equiv_attr fg another' ); 33 ok( !$pen->equiv( $pen2 ), '$pen is not equiv to a different one' ); 34} 35 36# Mutable pens 37{ 38 my $warnings = ""; 39 local $SIG{__WARN__} = sub { $warnings .= join " ", @_ }; 40 41 my $pen = Tickit::Pen::Mutable->new; 42 43 is( "$pen", "Tickit::Pen::Mutable{}", '"$pen" empty' ); 44 45 is_deeply( { $pen->getattrs }, {}, '$pen initial attrs' ); 46 ok( !$pen->hasattr( 'fg' ), '$pen initially lacks fg' ); 47 is( $pen->getattr( 'fg' ), undef, '$pen fg initially undef' ); 48 49 $pen->chattr( fg => 3 ); 50 51 is_deeply( { $pen->getattrs }, { fg => 3 }, '$pen attrs after chattr' ); 52 ok( $pen->hasattr( 'fg' ), '$pen now has fg' ); 53 is( $pen->getattr( 'fg' ), 3, '$pen fg after chattr' ); 54 55 is( "$pen", "Tickit::Pen::Mutable{fg=3}", '"$pen" after chattr' ); 56 57 is_deeply( { $pen->as_mutable->getattrs }, { $pen->getattrs }, '$pen->as_mutable attrs' ); 58 59 $pen->chattr( fg => "blue" ); 60 61 is_deeply( { $pen->getattrs }, { fg => 4 }, '$pen attrs fg named' ); 62 is( $pen->getattr( 'fg' ), 4, '$pen fg named' ); 63 64 $pen->chattr( fg => "hi-blue" ); 65 66 is_deeply( { $pen->getattrs }, { fg => 12 }, '$pen attrs fg named high-intensity' ); 67 is( $pen->getattr( 'fg' ), 12, '$pen fg named high-intensity' ); 68 69 $pen->delattr( 'fg' ); 70 71 is_deeply( { $pen->getattrs }, {}, '$pen attrs after delattr' ); 72 is( $pen->getattr( 'fg' ), undef, '$pen fg after delattr' ); 73 74 my %attrs = ( b => 1, na => 5 ); 75 76 $pen->chattrs( \%attrs ); 77 78 is_deeply( { $pen->getattrs }, { b => 1 }, '$pen attrs after chattrs' ); 79 is_deeply( \%attrs, { na => 5 }, '%attrs after chattrs' ); 80 81 $pen->chattr( fg => "red" ); 82} 83 84my $bluepen = Tickit::Pen::Immutable->new( fg => 4 ); 85my $otherpen = Tickit::Pen::Immutable->new( fg => 1, bg => 2 ); 86 87{ 88 my $copy = $bluepen->as_mutable; 89 90 is_deeply( { $copy->copy_from( $otherpen )->getattrs }, 91 { fg => 1, bg => 2 }, 92 'pen ->copy_from overwrites attributes' ); 93} 94 95{ 96 my $copy = $bluepen->as_mutable; 97 98 is_deeply( { $copy->default_from( $otherpen )->getattrs }, 99 { fg => 4, bg => 2 }, 100 'pen ->default_from does not overwrite attributes' ); 101} 102 103my $norv_pen = Tickit::Pen->new( rv => 0 ); 104$norv_pen->default_from( Tickit::Pen->new( rv => 1 ) ); 105is_deeply( { $norv_pen->getattrs }, 106 { rv => '' }, 107 'pen ->default_from does not overwrite defined-but-false attributes' ); 108 109# RGB8 in pens 110{ 111 my $pen = Tickit::Pen->new( 112 fg => 15, 113 "fg:rgb8" => "#f0f0f0", 114 ); 115 116 ok( $pen->hasattr( "fg:rgb8" ), '$pen has fg:rgb8' ); 117 is( $pen->getattr( "fg:rgb8" ), "#F0F0F0", '$pen fg:rgb8 attr value' ); 118 119 $pen->chattr( "fg:rgb8" => "#F1F2F3" ); 120 is( $pen->getattr( "fg:rgb8" ), "#F1F2F3", '$pen fg:rgb8 attr new value' ); 121 122 is_deeply( { $pen->getattrs }, 123 { fg => 15, "fg:rgb8" => "#F1F2F3" }, 124 '$pen->getattrs' ); 125 126 $pen->chattr( "fg:rgb8" => undef ); 127 ok( !$pen->hasattr( "fg:rgb8" ), '$pen has no fg:rgb8' ); 128} 129 130done_testing; 131