[Rt-commit] r5635 - in Object-Declare: inc/Test lib/Object t
audreyt at bestpractical.com
audreyt at bestpractical.com
Thu Jul 20 23:16:55 EDT 2006
Author: audreyt
Date: Thu Jul 20 23:16:54 2006
New Revision: 5635
Modified:
Object-Declare/Changes
Object-Declare/inc/Test/Builder.pm
Object-Declare/inc/Test/More.pm
Object-Declare/lib/Object/Declare.pm
Object-Declare/t/01-basic.t
Log:
* This be 0.10.
* The "copula" interface now accepts an arbitrary prefix for each
copula (defaults to ''), which can be used to distinguish labels
built by different copular words.
Modified: Object-Declare/Changes
==============================================================================
--- Object-Declare/Changes (original)
+++ Object-Declare/Changes Thu Jul 20 23:16:54 2006
@@ -1,3 +1,9 @@
+[Changes for 0.10 - 2006-07-20]
+
+* The "copula" interface now accepts an arbitrary prefix for each
+ copula (defaults to ''), which can be used to distinguish labels
+ built by different copular words.
+
[Changes for 0.09 - 2006-07-18]
* The "mapping" interface now accepts arbitrary code reference as the
Modified: Object-Declare/inc/Test/Builder.pm
==============================================================================
--- Object-Declare/inc/Test/Builder.pm (original)
+++ Object-Declare/inc/Test/Builder.pm Thu Jul 20 23:16:54 2006
@@ -9,7 +9,7 @@
use strict;
use vars qw($VERSION);
-$VERSION = '0.32';
+$VERSION = '0.33';
$VERSION = eval $VERSION; # make the alpha version come out as a number
# Make Test::Builder thread-safe for ithreads.
Modified: Object-Declare/inc/Test/More.pm
==============================================================================
--- Object-Declare/inc/Test/More.pm (original)
+++ Object-Declare/inc/Test/More.pm Thu Jul 20 23:16:54 2006
@@ -17,7 +17,7 @@
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.62';
+$VERSION = '0.64';
$VERSION = eval $VERSION; # make the alpha version come out as a number
use Test::Builder::Module;
@@ -130,6 +130,12 @@
my $class = ref $proto || $proto;
my $tb = Test::More->builder;
+ unless( $class ) {
+ my $ok = $tb->ok( 0, "->can(...)" );
+ $tb->diag(' can_ok() called with empty class or reference');
+ return $ok;
+ }
+
unless( @methods ) {
my $ok = $tb->ok( 0, "$class->can(...)" );
$tb->diag(' can_ok() called with no methods');
@@ -146,7 +152,7 @@
my $name;
$name = @methods == 1 ? "$class->can('$methods[0]')"
: "$class->can(...)";
-
+
my $ok = $tb->ok( !@nok, $name );
$tb->diag(map " $class->can('$_') failed\n", @nok);
@@ -154,7 +160,7 @@
return $ok;
}
-#line 519
+#line 525
sub isa_ok ($$;$) {
my($object, $class, $obj_name) = @_;
@@ -209,7 +215,7 @@
}
-#line 589
+#line 595
sub pass (;$) {
my $tb = Test::More->builder;
@@ -221,7 +227,7 @@
$tb->ok(0, @_);
}
-#line 650
+#line 656
sub use_ok ($;@) {
my($module, @imports) = @_;
@@ -263,7 +269,7 @@
return $ok;
}
-#line 699
+#line 705
sub require_ok ($) {
my($module) = shift;
@@ -306,7 +312,7 @@
$module =~ /^[a-zA-Z]\w*$/;
}
-#line 775
+#line 781
use vars qw(@Data_Stack %Refs_Seen);
my $DNE = bless [], 'Does::Not::Exist';
@@ -407,7 +413,7 @@
return '';
}
-#line 915
+#line 921
sub diag {
my $tb = Test::More->builder;
@@ -416,7 +422,7 @@
}
-#line 984
+#line 990
#'#
sub skip {
@@ -430,6 +436,11 @@
$how_many = 1;
}
+ if( defined $how_many and $how_many =~ /\D/ ) {
+ _carp "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?";
+ $how_many = 1;
+ }
+
for( 1..$how_many ) {
$tb->skip($why);
}
@@ -439,7 +450,7 @@
}
-#line 1066
+#line 1077
sub todo_skip {
my($why, $how_many) = @_;
@@ -460,7 +471,7 @@
last TODO;
}
-#line 1119
+#line 1130
sub BAIL_OUT {
my $reason = shift;
@@ -469,7 +480,7 @@
$tb->BAIL_OUT($reason);
}
-#line 1158
+#line 1169
#'#
sub eq_array {
@@ -593,7 +604,7 @@
}
-#line 1289
+#line 1300
sub eq_hash {
local @Data_Stack;
@@ -626,7 +637,7 @@
return $ok;
}
-#line 1346
+#line 1357
sub eq_set {
my($a1, $a2) = @_;
@@ -652,6 +663,6 @@
);
}
-#line 1534
+#line 1545
1;
Modified: Object-Declare/lib/Object/Declare.pm
==============================================================================
--- Object-Declare/lib/Object/Declare.pm (original)
+++ Object-Declare/lib/Object/Declare.pm Thu Jul 20 23:16:54 2006
@@ -4,7 +4,7 @@
use strict;
use warnings;
-$Object::Declare::VERSION = '0.09';
+$Object::Declare::VERSION = '0.10';
use Sub::Override;
@@ -43,6 +43,11 @@
}
}
+ if (ref($copula) eq 'ARRAY') {
+ # add an empty prefix to all copula
+ $copula = { map { $_ => '' } @$copula }
+ }
+
# Install declarator functions into caller's package, remembering
# the mapping and copula set for this declarator.
foreach my $sym (@$declarator) {
@@ -58,8 +63,8 @@
{
no strict 'refs';
*{"$from\::$_"} = \&{"$from\::$_"} for keys %$mapping;
- *{"UNIVERSAL::$_"} = \&{"UNIVERSAL::$_"} for @$copula;
- *{"$_\::AUTOLOAD"} = \&{"$_\::AUTOLOAD"} for @$copula;
+ *{"UNIVERSAL::$_"} = \&{"UNIVERSAL::$_"} for keys %$copula;
+ *{"$_\::AUTOLOAD"} = \&{"$_\::AUTOLOAD"} for keys %$copula;
}
}
@@ -92,9 +97,19 @@
# unrecognized calls for "foo is 1" (which gets translated to "is->foo(1)",
# and UNIVERSAL to collect "is foo" (which gets translated to "foo->is".
# The arguments are rolled into a Katamari structure for later analysis.
- foreach my $sym (@$copula) {
- $replace->("UNIVERSAL::$sym" => \&_universal);
- $replace->("$sym\::AUTOLOAD" => \&_autoload);
+ while (my ($sym, $prefix) = each %$copula) {
+ $replace->( "UNIVERSAL::$sym" => sub {
+ # Turn "is some_field" into "some_field is 1"
+ bless([$prefix.$_[0], 1] => 'Object::Declare::Katamari');
+ } );
+ $replace->( "$sym\::AUTOLOAD" => sub {
+ # Handle "some_field is $some_value"
+ shift;
+ my $field = our $AUTOLOAD;
+ $field =~ s/.*:://;
+ unshift @_, $prefix.$field;
+ bless(\@_, 'Object::Declare::Katamari');
+ } );
}
# Now install the collector symbols from class mappings
@@ -109,21 +124,6 @@
return(wantarray ? @objects : { @objects });
}
-# Turn "is some_field" into "some_field is 1"
-sub _universal {
- push @_, 1;
- bless(\@_, 'Object::Declare::Katamari');
-}
-
-# Handle "some_field is $some_value"
-sub _autoload {
- shift;
- my $field = our $AUTOLOAD;
- $field =~ s/.*:://;
- unshift @_, $field;
- bless(\@_, 'Object::Declare::Katamari');
-}
-
# Make a star from the Katamari!
sub _make_object {
my ($build, $schema) = @_;
@@ -197,8 +197,11 @@
(I<copula>), and the table of named classes to declare (I<mapping>):
use Object::Declare
- declarator => 'declare', # is the default
- copula => ['is', 'are'], # this is the default
+ declarator => ['declare'], # list of declarators
+ copula => { # list of words, or a map
+ is => '', # from copula to prefixes for
+ are => '', # labels built with that copula
+ }
mapping => {
column => 'MyApp::Column', # class name to call ->new to
param => sub { # arbitrary coderef also works
Modified: Object-Declare/t/01-basic.t
==============================================================================
--- Object-Declare/t/01-basic.t (original)
+++ Object-Declare/t/01-basic.t Thu Jul 20 23:16:54 2006
@@ -1,9 +1,14 @@
use strict;
use Test::More tests => 3, import => ['is_deeply'];
-use ok 'Object::Declare' => {
- column => 'MyApp::Column',
- alt_col => sub { return { alt => 1, @_ } }
-};
+use ok 'Object::Declare' =>
+ copula => {
+ is => '',
+ are => 'plural_',
+ },
+ mapping => {
+ column => 'MyApp::Column',
+ alt_col => sub { return { alt => 1, @_ } }
+ };
sub MyApp::Column::new { shift; return { @_ } }
@@ -25,7 +30,7 @@
is_deeply(\@objects => [
x => {
'field1' => 'xxx',
- 'field2' => ['XXX', 'XXX'],
+ 'plural_field2' => ['XXX', 'XXX'],
'field3' => 1,
'rw' => 1,
'happy' => 1,
@@ -42,7 +47,7 @@
is_deeply($objects => {
x => {
'field1' => 'xxx',
- 'field2' => ['XXX', 'XXX'],
+ 'plural_field2' => ['XXX', 'XXX'],
'field3' => 1,
'rw' => 1,
'happy' => 1,
More information about the Rt-commit
mailing list