0_03

diff --git a/Changes b/Changes
index 1c8ba4a..c4f1da8 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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