From: Stevan Little Date: Thu, 23 Mar 2006 15:56:05 +0000 (+0000) Subject: 0_03 X-Git-Tag: 0_05~65 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d7f17ebbbf3b45f39ea4f3ab2e7912520818264c;p=gitmo%2FMoose.git 0_03 --- diff --git a/Changes b/Changes index 1c8ba4a..c4f1da8 100644 --- a/Changes +++ b/Changes @@ -1,10 +1,25 @@ Revision history for Perl extension Moose 0.03 + * Moose + - fixed an issue with &extends super class loading + it now captures errors and deals with inline + packages correctly (bug found by mst, solution + stolen from alias) + + * Moose::Object + - BUILDALL now takes a reference of the %params + that are passed to &new, and passes that to + each BUILD as well. + * Moose::Meta::Class - fixed the way attribute defaults are handled during instance construction (bug found by chansen) + * Moose::Meta::Attribute + - read-only attributes now actually enforce their + read-only-ness + 0.02 Tues. March 21, 2006 * Moose - many more tests, fixing some bugs and diff --git a/MANIFEST b/MANIFEST index ef0e426..3dc5618 100644 --- a/MANIFEST +++ b/MANIFEST @@ -20,11 +20,13 @@ t/004_basic.t t/005_basic.t t/006_basic.t t/010_basic_class_setup.t +t/011_require_superclasses.t t/020_foreign_inheritence.t t/050_util_type_constraints.t t/051_util_type_constraints_export.t t/052_util_std_type_constraints.t t/053_util_find_type_constraint.t t/054_util_type_coercion.t +t/lib/Foo.pm t/pod.t t/pod_coverage.t diff --git a/lib/Moose.pm b/lib/Moose.pm index b7430cf..5ae01f6 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -60,7 +60,14 @@ sub import { # handle superclasses $meta->alias_method('extends' => subname 'Moose::extends' => sub { - $_->require for @_; + foreach my $super (@_) { + # see if this is already + # loaded in the symbol table + next if _is_class_already_loaded($super); + # otherwise require it ... + ($super->require) + || confess "Could not load superclass '$super' because : " . $UNIVERSAL::require::ERROR; + } $meta->superclasses(@_) }); @@ -119,6 +126,17 @@ sub import { $meta->alias_method('blessed' => \&Scalar::Util::blessed); } +sub _is_class_already_loaded { + my $name = shift; + no strict 'refs'; + return 1 if defined ${"${name}::VERSION"} || defined @{"${name}::ISA"}; + foreach (keys %{"${name}::"}) { + next if substr($_, -2, 2) eq '::'; + return 1 if defined &{"${name}::$_"}; + } + return 0; +} + 1; __END__ diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index e7a40bc..2430aec 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -133,6 +133,14 @@ sub generate_writer_method { } } +sub generate_reader_method { + my ($self, $attr_name) = @_; + sub { + confess "Cannot assign a value to a read-only accessor" if @_ > 1; + $_[0]->{$attr_name} + }; +} + 1; __END__ @@ -169,6 +177,8 @@ will behave just as L does. =item B +=item B + =back =head2 Additional Moose features diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm index fca7419..2fdf89d 100644 --- a/lib/Moose/Object.pm +++ b/lib/Moose/Object.pm @@ -12,14 +12,14 @@ our $VERSION = '0.02'; sub new { my ($class, %params) = @_; my $self = $class->meta->new_object(%params); - $self->BUILDALL(%params); + $self->BUILDALL(\%params); return $self; } sub BUILDALL { - my ($self, %params) = @_; + my ($self, $params) = @_; foreach my $method (reverse $self->meta->find_all_methods_by_name('BUILD')) { - $method->{code}->($self, %params); + $method->{code}->($self, $params); } } @@ -67,7 +67,8 @@ This will create a new instance and call C. =item B -This will call every C method in the inheritance hierarchy. +This will call every C method in the inheritance hierarchy, +and pass it a hash-ref of the the C<%params> passed to C. =item B diff --git a/t/001_basic.t b/t/001_basic.t index 7fc3718..8c022c2 100644 --- a/t/001_basic.t +++ b/t/001_basic.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 55; +use Test::More tests => 56; use Test::Exception; BEGIN { @@ -55,7 +55,9 @@ dies_ok { $point->y('Foo'); } '... cannot assign a non-Int to y'; -$point->x(1000); +dies_ok { + $point->x(1000); +} '... cannot assign to a read-only method'; is($point->x, 1, '... got the right (un-changed) value for x'); $point->clear(); diff --git a/t/002_basic.t b/t/002_basic.t index 4d3943b..ec98fd0 100644 --- a/t/002_basic.t +++ b/t/002_basic.t @@ -50,7 +50,6 @@ BEGIN { }; } - my $savings_account = BankAccount->new(balance => 250); isa_ok($savings_account, 'BankAccount'); diff --git a/t/003_basic.t b/t/003_basic.t index 259689f..57d10dd 100644 --- a/t/003_basic.t +++ b/t/003_basic.t @@ -43,17 +43,17 @@ BEGIN { }; sub BUILD { - my ($self, %params) = @_; - if ($params{parent}) { + my ($self, $params) = @_; + if ($params->{parent}) { # yeah this is a little # weird I know, but I wanted # to check the weaken stuff # in the constructor :) - if ($params{parent}->has_left) { - $params{parent}->right($self); + if ($params->{parent}->has_left) { + $params->{parent}->right($self); } else { - $params{parent}->left($self); + $params->{parent}->left($self); } } } diff --git a/t/004_basic.t b/t/004_basic.t index e9ac66d..7471289 100644 --- a/t/004_basic.t +++ b/t/004_basic.t @@ -58,9 +58,9 @@ BEGIN { }); sub BUILD { - my ($self, %params) = @_; - if ($params{employees}) { - foreach my $employee (@{$params{employees}}) { + my ($self, $params) = @_; + if ($params->{employees}) { + foreach my $employee (@{$params->{employees}}) { $employee->company($self); } } diff --git a/t/011_require_superclasses.t b/t/011_require_superclasses.t new file mode 100644 index 0000000..beacd42 --- /dev/null +++ b/t/011_require_superclasses.t @@ -0,0 +1,43 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use lib 't/lib', 'lib'; + +use Test::More tests => 4; + +BEGIN { + use_ok('Moose'); +} + +{ + package Bar; + use strict; + use warnings; + use Moose; + + eval { extends 'Foo'; }; + ::ok(!$@, '... loaded Foo superclass correctly'); +} + +{ + package Baz; + use strict; + use warnings; + use Moose; + + eval { extends 'Bar'; }; + ::ok(!$@, '... loaded (inline) Bar superclass correctly'); +} + +{ + package Foo::Bar; + use strict; + use warnings; + use Moose; + + eval { extends 'Foo', 'Bar'; }; + ::ok(!$@, '... loaded Foo and (inline) Bar superclass correctly'); +} + diff --git a/t/lib/Foo.pm b/t/lib/Foo.pm new file mode 100644 index 0000000..e09ab0e --- /dev/null +++ b/t/lib/Foo.pm @@ -0,0 +1,9 @@ + +package Foo; +use strict; +use warnings; +use Moose; + +has 'bar' => (is => 'rw'); + +1; \ No newline at end of file