Permalink
Browse files

Added tests for UNIVERSAL

  • Loading branch information...
1 parent 8354fc0 commit 518bff136911255fb0ca24ca9d7567e56be170df @quile committed Apr 28, 2012
Showing with 66 additions and 3 deletions.
  1. +0 −2 README.md
  2. +1 −0 t/01-run.t
  3. +0 −1 t/TestKeyValueCodingOnObject.pm
  4. +65 −0 t/TestKeyValueCodingUniversal.pm
View
@@ -4,8 +4,6 @@ Object::KeyValueCoding - Perl implementation of Key-Value Coding
# SYNOPSIS
- use Object::KeyValueCoding;
-
package Foo;
use Object::KeyValueCoding;
View
@@ -8,6 +8,7 @@ use lib '../lib';
use TestKeyValueCoding;
use TestKeyValueCodingOnObject;
use TestKeyValueCodingSimple;
+use TestKeyValueCodingUniversal;
BEGIN {
my $hasMoose = eval { require Moose };
unless ($@) {
@@ -31,7 +31,6 @@ sub test_object_properties : Tests {
sub test_additions : Tests {
my ( $self ) = @_;
my $obj = $self->{obj};
- $DB::single = 1;
is_deeply( $obj->valueForKey( "sorted(taylorColeridge)" ), [ "kublai khan", "samuel", "xanadu" ], "sorted" );
is_deeply( $obj->valueForKey( "reversed(sorted(taylorColeridge))" ), [ "xanadu", "samuel", "kublai khan" ], "reversed" );
is_deeply( $obj->valueForKey( "sorted(keys(donne))" ), [ "bruce", "john" ], "sorted keys" );
@@ -0,0 +1,65 @@
+package TestKeyValueCodingUniversal;
+
+use strict;
+
+# This rather salacious line adds key-value coding to
+# every class in the system.
+use Object::KeyValueCoding target => "UNIVERSAL";
+
+use base qw(
+ Test::Class
+);
+
+use Test::More;
+
+sub setUp : Test(startup) {
+ my ( $self ) = @_;
+ $self->{obj} = _UniversalTestThing->new();
+ $self->{obj}->setValueForKey( "william", "shakespeare" );
+}
+
+sub test_object_properties : Tests {
+ my ( $self ) = @_;
+ my $obj = $self->valueForKey("obj");
+ $self->setValueForKey( "francis", "obj.bacon" );
+
+ ok( $obj->valueForKey( "shakespeare" ) eq "william", "william shakespeare" );
+ ok( $obj->valueForKey( "marlowe" ) eq "christopher", "christopher marlowe" );
+ ok( $obj->valueForKey( "bacon" ) eq "francis", "francis bacon" );
+
+ ok( $obj->valueForKey( "_s('donne')" ) eq "DONNE", "john donne" );
+ ok( $obj->valueForKey( "donne.john" ) eq "jonny", "jonny" );
+ ok( $obj->valueForKey( "_s(donne.john)" ) eq "JONNY", "JONNY" );
+}
+
+# Note that KeyValueCoding is not mentioned here at all:
+package _UniversalTestThing;
+
+sub new {
+ my ( $class ) = @_;
+ return bless {
+ bacon => undef,
+ }, $class;
+}
+
+sub shakespeare { return $_[0]->{shakespeare} }
+sub setShakespeare { $_[0]->{shakespeare} = $_[1] }
+
+sub marlowe { return "christopher" }
+
+sub bacon { return $_[0]->{bacon} }
+sub setBacon { $_[0]->{bacon} = $_[1] }
+
+sub _s {
+ my ( $self, $value ) = @_;
+ return uc($value);
+}
+
+sub donne {
+ return {
+ "john" => 'jonny',
+ "bruce" => 'brucey'
+ };
+}
+
+1;

0 comments on commit 518bff1

Please sign in to comment.