Bring shika-based up to trunk
Shawn M Moore [Tue, 9 Dec 2008 02:36:04 +0000 (02:36 +0000)]
1  2 
lib/Mouse.pm
t/017-default-reference.t
t/025-more-isa.t

diff --combined lib/Mouse.pm
@@@ -1,25 -1,14 +1,24 @@@
 -#!/usr/bin/env perl
 +
  package Mouse;
  use strict;
  use warnings;
 +use 5.006;
  use base 'Exporter';
  
- our $VERSION;
+ our $VERSION = '0.13';
+ use 5.006;
  
 +BEGIN {
-     $VERSION  = '0.12';
 +    if ($ENV{MOUSE_DEBUG}) {
 +        *DEBUG = sub (){ 1 };
 +    } else {
 +        *DEBUG = sub (){ 0 };
 +    }
 +}
 +
  use Carp 'confess';
 -use Mouse::Util 'blessed';
 +use Scalar::Util 'blessed';
 +use Mouse::Util;
  
  use Mouse::Meta::Attribute;
  use Mouse::Meta::Class;
@@@ -77,12 -66,17 +76,12 @@@ sub around 
  }
  
  sub with {
 -    my $meta = Mouse::Meta::Class->initialize(caller);
 -
 -    my $role  = shift;
 -
 -    confess "Mouse::Role only supports 'with' on individual roles at a time" if @_;
 -
 -    Mouse::load_class($role);
 -    $role->meta->apply($meta);
 +    Mouse::Util::apply_all_roles((caller)[0], @_);
  }
  
  sub import {
 +    my $class = shift;
 +
      strict->import;
      warnings->import;
  
      no warnings 'redefine';
      *{$caller.'::meta'} = sub { $meta };
  
 -    Mouse->export_to_level(1, @_);
 +    if (@_) {
 +        __PACKAGE__->export_to_level( 1, $class, @_);
 +    } else {
 +        # shortcut for the common case of no type character
 +        no strict 'refs';
 +        for my $keyword (@EXPORT) {
 +            *{ $caller . '::' . $keyword } = *{__PACKAGE__ . '::' . $keyword};
 +        }
 +    }
  }
  
  sub unimport {
@@@ -124,7 -110,6 +123,7 @@@ sub load_class 
          confess "Invalid class name ($display)";
      }
  
 +    return 1 if $class eq 'Mouse::Object';
      return 1 if is_class_loaded($class);
  
      (my $file = "$class.pm") =~ s{::}{/}g;
@@@ -1,8 -1,8 +1,8 @@@
  #!/usr/bin/env perl
  use strict;
  use warnings;
- use Test::More tests => 8;
+ use Test::More tests => 9;
 -use Mouse::Util ':test';
 +use Test::Exception;
  
  do {
      package Class;
@@@ -48,3 -48,15 +48,15 @@@ is(ref(Class->new->code), 'CODE', "defa
  is(Class->new->code->(), 1, "default => sub sub strips off the first coderef");
  is_deeply(Class->new->a, [1], "default of sub { reference } works");
  
+ do {
+   package Class::Two;
+   use Mouse;
+   has foo => (is => 'rw', default => sub {
+     die unless $_[0]->isa('Class::Two');
+     shift->default_foo;
+   });
+   sub default_foo { 1 };
+ };
+ my $obj2 = Class::Two->new;
+ is($obj2->foo, 1, 'default method gets the $_[0] it needs to work');
diff --combined t/025-more-isa.t
@@@ -1,8 -1,8 +1,8 @@@
  #!/usr/bin/env perl
  use strict;
  use warnings;
- use Test::More tests => 29;
+ use Test::More tests => 30;
 -use Mouse::Util ':test';
 +use Test::Exception;
  
  do {
      package Class;
@@@ -12,6 -12,9 +12,9 @@@
          is  => 'rw',
          isa => 'Test::Builder',
      );
+     package Test::Builder::Subclass;
+     our @ISA = qw(Test::Builder);
  };
  
  can_ok(Class => 'tb');
@@@ -21,6 -24,13 +24,13 @@@ lives_ok 
  };
  
  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 {
      my $class = Class->new;
      $class->tb(Test::Builder->new);
      isa_ok($class->tb, 'Test::Builder');