From: Stevan Little <stevan.little@iinteractive.com>
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<Class::MOP::Attribute> does.
=item B<generate_writer_method>
+=item B<generate_reader_method>
+
=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<BUILDALL>.
=item B<BUILDALL>
-This will call every C<BUILD> method in the inheritance hierarchy.
+This will call every C<BUILD> method in the inheritance hierarchy,
+and pass it a hash-ref of the the C<%params> passed to C<new>.
=item B<DEMOLISHALL>
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