r27764 - in /branches/upstream/libmouse-perl/current: Changes lib/Mouse.pm lib/Mouse/Meta/Attribute.pm lib/Mouse/Tiny.pm lib/Mouse/Util.pm t/025-more-isa.t
bricas-guest at users.alioth.debian.org
bricas-guest at users.alioth.debian.org
Fri Dec 5 12:40:36 UTC 2008
Author: bricas-guest
Date: Fri Dec 5 12:40:33 2008
New Revision: 27764
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=27764
Log:
[svn-upgrade] Integrating new upstream version, libmouse-perl (0.12)
Modified:
branches/upstream/libmouse-perl/current/Changes
branches/upstream/libmouse-perl/current/lib/Mouse.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pm
branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm
branches/upstream/libmouse-perl/current/t/025-more-isa.t
Modified: branches/upstream/libmouse-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/Changes?rev=27764&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/Changes (original)
+++ branches/upstream/libmouse-perl/current/Changes Fri Dec 5 12:40:33 2008
@@ -1,4 +1,13 @@
Revision history for Mouse
+
+0.12 Thu Dec 4 19:23:10 2008
+ * Provide Test::Exception function unless it's version 0.27 - RT #41254
+
+ * Mouse::Util now provides dies_ok
+
+ * Make class-like types behave more like Moose; subclasses OK! (rjbs)
+
+ * Steal more tests from Moose
0.11 Sun Nov 2 11:35:04 2008
* Throw an error if accessor/predicate/clearer/handles code eval fails
Modified: branches/upstream/libmouse-perl/current/lib/Mouse.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse.pm?rev=27764&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse.pm Fri Dec 5 12:40:33 2008
@@ -4,7 +4,7 @@
use warnings;
use base 'Exporter';
-our $VERSION = '0.11';
+our $VERSION = '0.12';
use 5.006;
use Carp 'confess';
@@ -360,6 +360,11 @@
bucket status). You must specify an appropriate type constraint to use
auto_deref.
+=item lazy_build => 0|1
+
+Automatically define lazy => 1 as well as builder => "_build_$attr", clearer =>
+"clear_$attr', predicate => 'has_$attr' unless they are already defined.
+
=back
=head2 confess error -> BOOM
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm?rev=27764&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Meta/Attribute.pm Fri Dec 5 12:40:33 2008
@@ -294,7 +294,7 @@
my $checker = Mouse::TypeRegistry->optimized_constraints->{$type};
return $checker if $checker;
- return sub { blessed($_) && blessed($_) eq $type };
+ return sub { blessed($_) && $_->isa($type) };
}
sub verify_type_constraint {
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pm?rev=27764&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Tiny.pm Fri Dec 5 12:40:33 2008
@@ -7,6 +7,7 @@
# tell Perl we already have all of the Mouse files loaded:
$INC{'Mouse.pm'} = __FILE__;
+$INC{'ouse.pm'} = __FILE__;
$INC{'Mouse/Object.pm'} = __FILE__;
$INC{'Mouse/Role.pm'} = __FILE__;
$INC{'Mouse/TypeRegistry.pm'} = __FILE__;
@@ -140,7 +141,7 @@
# ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^
},
# VVVVV CODE TAKEN FROM TEST::EXCEPTION VVVVV
- 'Test::Exception' => do {
+ 'Test::Exception 0.27' => do {
my $Tester;
@@ -212,16 +213,18 @@
test => [qw/throws_ok lives_ok/],
);
- for my $module_name (keys %dependencies) {
+ for my $module (keys %dependencies) {
+ my ($module_name, $version) = split ' ', $module;
+
my $loaded = do {
local $SIG{__DIE__} = 'DEFAULT';
- eval "require $module_name; 1";
+ eval "use $module (); 1";
};
$loaded{$module_name} = $loaded;
- for my $method_name (keys %{ $dependencies{ $module_name } }) {
- my $producer = $dependencies{$module_name}{$method_name};
+ for my $method_name (keys %{ $dependencies{ $module } }) {
+ my $producer = $dependencies{$module}{$method_name};
my $implementation;
if (ref($producer) eq 'HASH') {
@@ -246,7 +249,7 @@
use warnings;
use base 'Exporter';
-our $VERSION = '0.09';
+our $VERSION = '0.12';
use 5.006;
use Carp 'confess';
@@ -438,94 +441,114 @@
$_[0]->{_create_args}
}
+sub inlined_name {
+ my $self = shift;
+ my $name = $self->name;
+ my $key = "'" . $name . "'";
+ return $key;
+}
+
sub generate_accessor {
my $attribute = shift;
- my $name = $attribute->name;
- my $key = $name;
- my $default = $attribute->default;
- my $type = $attribute->type_constraint;
- my $constraint = $attribute->find_type_constraint;
- my $builder = $attribute->builder;
- my $trigger = $attribute->trigger;
-
- my $accessor = 'sub {
- my $self = shift;';
-
+ my $name = $attribute->name;
+ my $default = $attribute->default;
+ my $type = $attribute->type_constraint;
+ my $constraint = $attribute->find_type_constraint;
+ my $builder = $attribute->builder;
+ my $trigger = $attribute->trigger;
+ my $is_weak = $attribute->is_weak_ref;
+ my $should_deref = $attribute->should_auto_deref;
+
+ my $self = '$_[0]';
+ my $key = $attribute->inlined_name;
+
+ my $accessor = "sub {\n";
if ($attribute->_is_metadata eq 'rw') {
- $accessor .= 'if (@_) {
- local $_ = $_[0];';
+ $accessor .= 'if (scalar(@_) >= 2) {' . "\n";
+
+ my $value = '$_[1]';
if ($constraint) {
- $accessor .= 'unless ($constraint->()) {
+ $accessor .= 'local $_ = '.$value.';
+ unless ($constraint->()) {
my $display = defined($_) ? overload::StrVal($_) : "undef";
Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $display");
- }'
- }
-
- $accessor .= '$self->{$key} = $_;';
-
- if ($attribute->is_weak_ref) {
- $accessor .= 'weaken($self->{$key}) if ref($self->{$key});';
+ }' . "\n"
+ }
+
+ # if there's nothing left to do for the attribute we can return during
+ # this setter
+ $accessor .= 'return ' if !$is_weak && !$trigger && !$should_deref;
+
+ $accessor .= $self.'->{'.$key.'} = '.$value.';' . "\n";
+
+ if ($is_weak) {
+ $accessor .= 'weaken('.$self.'->{'.$key.'}) if ref('.$self.'->{'.$key.'});' . "\n";
}
if ($trigger) {
- $accessor .= '$trigger->($self, $_, $attribute);';
- }
-
- $accessor .= '}';
+ $accessor .= '$trigger->('.$self.', '.$value.', $attribute);' . "\n";
+ }
+
+ $accessor .= "}\n";
}
else {
- $accessor .= 'confess "Cannot assign a value to a read-only accessor" if @_;';
+ $accessor .= 'confess "Cannot assign a value to a read-only accessor" if scalar(@_) >= 2;' . "\n";
}
if ($attribute->is_lazy) {
- $accessor .= '$self->{$key} = ';
+ $accessor .= $self.'->{'.$key.'} = ';
$accessor .= $attribute->has_builder
- ? '$self->$builder'
- : ref($default) eq 'CODE'
- ? '$default->($self)'
- : '$default';
-
- $accessor .= ' if !exists($self->{$key});';
- }
-
- if ($attribute->should_auto_deref) {
+ ? $self.'->$builder'
+ : ref($default) eq 'CODE'
+ ? '$default->('.$self.')'
+ : '$default';
+ $accessor .= ' if !exists '.$self.'->{'.$key.'};' . "\n";
+ }
+
+ if ($should_deref) {
if ($attribute->type_constraint eq 'ArrayRef') {
$accessor .= 'if (wantarray) {
- return @{ $self->{$key} || [] };
+ return @{ '.$self.'->{'.$key.'} || [] };
}';
}
else {
$accessor .= 'if (wantarray) {
- return %{ $self->{$key} || {} };
+ return %{ '.$self.'->{'.$key.'} || {} };
}';
}
}
- $accessor .= 'return $self->{$key};
+ $accessor .= 'return '.$self.'->{'.$key.'};
}';
- return eval $accessor;
+ my $sub = eval $accessor;
+ confess $@ if $@;
+ return $sub;
}
sub generate_predicate {
my $attribute = shift;
- my $key = $attribute->name;
-
- my $predicate = 'sub { exists($_[0]->{$key}) }';
-
- return eval $predicate;
+ my $key = $attribute->inlined_name;
+
+ my $predicate = 'sub { exists($_[0]->{'.$key.'}) }';
+
+ my $sub = eval $predicate;
+ confess $@ if $@;
+ return $sub;
}
sub generate_clearer {
my $attribute = shift;
- my $key = $attribute->name;
-
- my $predicate = 'sub { delete($_[0]->{$key}) }';
-
- return eval $predicate;
+ my $key = $attribute->inlined_name;
+
+ my $clearer = 'sub { delete($_[0]->{'.$key.'}) }';
+
+ my $sub = eval $clearer;
+ confess $@ if $@;
+ return $sub;
}
sub generate_handles {
@@ -544,6 +567,7 @@
}';
$method_map{$local_method} = eval $method;
+ confess $@ if $@;
}
return \%method_map;
@@ -1195,6 +1219,22 @@
};
}
+
+use strict;
+use warnings;
+
+BEGIN {
+ my $package;
+ sub import {
+ $package = $_[1] || 'Class';
+ if ($package =~ /^\+/) {
+ $package =~ s/^\+//;
+ eval "require $package; 1" or die;
+ }
+ }
+ use Filter::Simple sub { s/^/package $package;\nuse Mouse;\n/; }
+}
+
}; #eval
} #unless
Modified: branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm?rev=27764&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm (original)
+++ branches/upstream/libmouse-perl/current/lib/Mouse/Util.pm Fri Dec 5 12:40:33 2008
@@ -122,7 +122,7 @@
# ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^
},
# VVVVV CODE TAKEN FROM TEST::EXCEPTION VVVVV
- 'Test::Exception' => do {
+ 'Test::Exception 0.27' => do {
my $Tester;
@@ -182,6 +182,16 @@
$@ = $exception;
return $ok;
},
+ 'dies_ok' => sub (&;$) {
+ my ( $coderef, $description ) = @_;
+ my $exception = $try_as_caller->( $coderef );
+
+ $Tester ||= Test::Builder->new;
+
+ my $ok = $Tester->ok( $is_exception->( $exception ), $description );
+ $@ = $exception;
+ return $ok;
+ },
},
},
);
@@ -191,19 +201,21 @@
our @EXPORT_OK = map { keys %$_ } values %dependencies;
our %EXPORT_TAGS = (
all => \@EXPORT_OK,
- test => [qw/throws_ok lives_ok/],
+ test => [qw/throws_ok lives_ok dies_ok/],
);
- for my $module_name (keys %dependencies) {
+ for my $module (keys %dependencies) {
+ my ($module_name, $version) = split ' ', $module;
+
my $loaded = do {
local $SIG{__DIE__} = 'DEFAULT';
- eval "require $module_name; 1";
+ eval "use $module (); 1";
};
$loaded{$module_name} = $loaded;
- for my $method_name (keys %{ $dependencies{ $module_name } }) {
- my $producer = $dependencies{$module_name}{$method_name};
+ for my $method_name (keys %{ $dependencies{ $module } }) {
+ my $producer = $dependencies{$module}{$method_name};
my $implementation;
if (ref($producer) eq 'HASH') {
@@ -256,6 +268,8 @@
=head3 throws_ok
+=head3 dies_ok
+
=head3 lives_ok
=cut
Modified: branches/upstream/libmouse-perl/current/t/025-more-isa.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmouse-perl/current/t/025-more-isa.t?rev=27764&op=diff
==============================================================================
--- branches/upstream/libmouse-perl/current/t/025-more-isa.t (original)
+++ branches/upstream/libmouse-perl/current/t/025-more-isa.t Fri Dec 5 12:40:33 2008
@@ -1,7 +1,7 @@
#!/usr/bin/env perl
use strict;
use warnings;
-use Test::More tests => 29;
+use Test::More tests => 30;
use Mouse::Util ':test';
do {
@@ -12,12 +12,22 @@
is => 'rw',
isa => 'Test::Builder',
);
+
+ package Test::Builder::Subclass;
+ our @ISA = qw(Test::Builder);
};
can_ok(Class => 'tb');
lives_ok {
Class->new(tb => Test::Builder->new);
+};
+
+lives_ok {
+ # Test::Builder was a bizarre choice, because it's a singleton. Because of
+ # that calling new on T:B:S won't work. Blessing directly -- rjbs,
+ # 2008-12-04
+ Class->new(tb => (bless {} => 'Test::Builder::Subclass'));
};
lives_ok {
More information about the Pkg-perl-cvs-commits
mailing list