Bring shika-based up to trunk

diff --git a/Changes b/Changes
index 704df1e..961cad7 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,17 @@
 Revision history for Mouse
 
-0.12
+0.13
+    * Pass in the instance to the default sub in the constructor (reported with
+      failing tests by rjbs)
+
+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

diff --git a/lib/Mouse.pm b/lib/Mouse.pm
index 2f61610..1887893 100644 (file)
--- a/lib/Mouse.pm
+++ b/lib/Mouse.pm
@@ -5,11 +5,10 @@ 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 {

diff --git a/t/017-default-reference.t b/t/017-default-reference.t
index 41d2593..8d1a354 100644 (file)
--- a/t/017-default-reference.t
+++ b/t/017-default-reference.t
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 8;
+use Test::More tests => 9;
 use Test::Exception;
 
 do {
@@ -48,3 +48,15 @@ is(ref(Class->new->code), 'CODE', "default => sub { sub { 1 } } stuffs a coderef
 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 --git a/t/025-more-isa.t b/t/025-more-isa.t
index 132d57f..e59ef90 100644 (file)
--- a/t/025-more-isa.t
+++ b/t/025-more-isa.t
@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 29;
+use Test::More tests => 30;
 use Test::Exception;
 
 do {
@@ -12,6 +12,9 @@ do {
         is  => 'rw',
         isa => 'Test::Builder',
     );
+
+    package Test::Builder::Subclass;
+    our @ISA = qw(Test::Builder);
 };
 
 can_ok(Class => 'tb');
@@ -21,6 +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');

diff --git a/t/033-readwrite.t b/t/033-readwrite.t
new file mode 100644 (file)
index 0000000..78f45f8
--- /dev/null
+++ b/t/033-readwrite.t
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 4;
+use Mouse::Util ':test';
+
+do {
+    package Class;
+    use Mouse;
+
+    # We want this attr to have a reader and writer with unconventional names,
+    # and not the default rw_attr method. -- rjbs, 2008-12-04
+    has 'rw_attr' => (
+        reader => 'read_attr',
+        writer => 'write_attr',
+    );;
+};
+
+my $object = Class->new;
+
+TODO: {
+  local $TODO = 'requires some refactoring to implement';
+
+  ok(
+    !$object->can('rw_attr'),
+    "no rw_attr method because wasn't 'is' ro or rw"
+  );
+  ok($object->can('read_attr'),  "did get a reader");
+  ok($object->can('write_attr'), "did get a writer");
+
+  # eliminate these eval{} when out of TODO
+  eval { $object->write_attr(2); };
+
+  is(
+    eval { $object->read_attr },
+    2,
+    "writing to the object worked",
+  );
+}

diff --git a/t/603-octal-defaults.t b/t/603-octal-defaults.t
new file mode 100644 (file)
index 0000000..8e41449
--- /dev/null
+++ b/t/603-octal-defaults.t
@@ -0,0 +1,119 @@
+#!/usr/bin/env perl
+use Test::More qw(no_plan);
+
+# copied straight out of Moose t/100/019
+
+{
+    my $package = qq{
+package Test::Mouse::Go::Boom;
+use Mouse;
+use lib qw(lib);
+
+has id => (
+    isa     => 'Str',
+    is      => 'ro',
+    default => '019600', # this caused the original failure
+);
+
+no Mouse;
+
+__PACKAGE__->meta->make_immutable;
+};
+
+    eval $package;
+    $@ ? ::fail($@) : ::pass('quoted 019600 default works');
+    my $obj = Test::Mouse::Go::Boom->new;
+    ::is( $obj->id, '019600', 'value is still the same' );
+}
+
+{
+    my $package = qq{
+package Test::Mouse::Go::Boom2;
+use Mouse;
+use lib qw(lib);
+
+has id => (
+    isa     => 'Str',
+    is      => 'ro',
+    default => 017600, 
+);
+
+no Mouse;
+
+__PACKAGE__->meta->make_immutable;
+};
+
+    eval $package;
+    $@ ? ::fail($@) : ::pass('017600 octal default works');
+    my $obj = Test::Mouse::Go::Boom2->new;
+    ::is( $obj->id, 8064, 'value is still the same' );
+}
+
+{
+    my $package = qq{
+package Test::Mouse::Go::Boom3;
+use Mouse;
+use lib qw(lib);
+
+has id => (
+    isa     => 'Str',
+    is      => 'ro',
+    default => 0xFF,  
+);
+
+no Mouse;
+
+__PACKAGE__->meta->make_immutable;
+};
+
+    eval $package;
+    $@ ? ::fail($@) : ::pass('017600 octal default works');
+    my $obj = Test::Mouse::Go::Boom3->new;
+    ::is( $obj->id, 255, 'value is still the same' );
+}
+
+{
+    my $package = qq{
+package Test::Mouse::Go::Boom4;
+use Mouse;
+use lib qw(lib);
+
+has id => (
+    isa     => 'Str',
+    is      => 'ro',
+    default => '0xFF',  
+);
+
+no Mouse;
+
+__PACKAGE__->meta->make_immutable;
+};
+
+    eval $package;
+    $@ ? ::fail($@) : ::pass('017600 octal default works');
+    my $obj = Test::Mouse::Go::Boom4->new;
+    ::is( $obj->id, '0xFF', 'value is still the same' );
+}
+
+{
+    my $package = qq{
+package Test::Mouse::Go::Boom5;
+use Mouse;
+use lib qw(lib);
+
+has id => (
+    isa     => 'Str',
+    is      => 'ro',
+    default => '0 but true',  
+);
+
+no Mouse;
+
+__PACKAGE__->meta->make_immutable;
+};
+
+    eval $package;
+    $@ ? ::fail($@) : ::pass('017600 octal default works');
+    my $obj = Test::Mouse::Go::Boom5->new;
+    ::is( $obj->id, '0 but true', 'value is still the same' );
+}