summaryrefslogtreecommitdiff
path: root/t/05-tied.t
diff options
context:
space:
mode:
Diffstat (limited to 't/05-tied.t')
-rw-r--r--t/05-tied.t80
1 files changed, 80 insertions, 0 deletions
diff --git a/t/05-tied.t b/t/05-tied.t
new file mode 100644
index 0000000..cc11312
--- /dev/null
+++ b/t/05-tied.t
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+
+use Test::Most;
+
+use lib 't/lib';
+
+use_ok( 'Graphics::ColorNames', '3.3', qw( hex2tuple tuple2hex ) );
+
+tie my %colors, 'Graphics::ColorNames';
+ok( tied %colors );
+
+my $count = 0;
+foreach my $name ( keys %colors ) {
+ my @RGB = hex2tuple( $colors{$name} );
+ $count++, if ( tuple2hex(@RGB) eq $colors{$name} );
+}
+ok( $count == keys %colors );
+
+$count = 0;
+foreach my $name ( keys %colors ) {
+ $count++, if ( $colors{ lc($name) } eq $colors{ uc($name) } );
+}
+ok( $count == keys %colors );
+
+$count = 0;
+foreach my $name ( keys %colors ) {
+ $count++, if ( exists( $colors{$name} ) );
+}
+ok( $count == keys %colors );
+
+$count = 0;
+foreach my $name ( keys %colors ) {
+ my $rgb = $colors{$name};
+ $count++, if ( defined $colors{$rgb} );
+ $count++, if ( defined $colors{ "\x23" . $rgb } );
+}
+ok( $count == ( 2 * ( keys %colors ) ) );
+
+# Test CLEAR, DELETE and STORE as returning errors
+
+dies_ok { undef %colors } "undef %colors";
+
+dies_ok { %colors = (); } "%colors = ()";
+
+dies_ok { $colors{MyCustomColor} = 'FFFFFF'; } "STORE";
+
+dies_ok { delete( $colors{MyCustomColor} ); } "DELETE";
+
+# Test RGB values being passed through
+
+foreach my $rgb (
+ qw(
+ 000000 000001 000010 000100 001000 010000 100000
+ 111111 123abc abc123 123ABC ABC123 abcdef ABCDEF
+ )
+ )
+{
+ ok( $colors{ "\x23" . $rgb } eq lc($rgb) );
+ ok( $colors{ "0x" . $rgb } eq lc($rgb) );
+ ok( $colors{$rgb} eq lc($rgb) );
+}
+
+# Test using multiple schemes, with issues in overlapping
+
+tie my %colors3, 'Graphics::ColorNames', qw( X Test );
+
+tie my %colors4, 'Graphics::ColorNames', qw( Test X );
+
+# Test precedence
+
+ok( $colors{DarkGreen} eq '006400' ); # DarkGreen in X
+ok( $colors3{DarkGreen} eq '006400' ); # DarkGreen in X
+ok( $colors4{DarkGreen} eq '008000' ); # DarkGreen in Test
+
+# Test handling of non-existent color names
+
+ok( !defined $colors{NonExistentColorName} );
+ok( !exists $colors{NonExistentColorName} );
+
+done_testing;