From: Stevan Little <stevan.little@iinteractive.com>
Date: Fri, 21 Apr 2006 17:42:21 +0000 (+0000)
Subject: types
X-Git-Tag: 0_05~14
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f65cb5347d0bfa2de4cafa99ba71bad39a1d1691;p=gitmo%2FMoose.git

types
---

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index c1b6b9c..d987f0e 100644
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -103,12 +103,16 @@ sub message (&) { $_[0] }
 
 # define some basic types
 
-type 'Any' => where { 1 };
+type 'Any'  => where { 1 }; # meta-type including all
+type 'Item' => where { 1 }; # base-type 
 
-subtype 'Value' => as 'Any' => where { !ref($_) };
-subtype 'Ref'   => as 'Any' => where {  ref($_) };
+subtype 'Undef'   => as 'Item' => where { !defined($_) };
+subtype 'Defined' => as 'Item' => where {  defined($_) };
 
-subtype 'Bool' => as 'Any' => where { "$_" eq '1' || "$_" eq '0' };
+subtype 'Value' => as 'Item' => where { !ref($_) };
+subtype 'Ref'   => as 'Item' => where {  ref($_) };
+
+subtype 'Bool'  => as 'Item' => where { "$_" eq '1' || "$_" eq '0' };
 
 subtype 'Int' => as 'Value' => where {  Scalar::Util::looks_like_number($_) };
 subtype 'Str' => as 'Value' => where { !Scalar::Util::looks_like_number($_) };
@@ -179,6 +183,10 @@ This module also provides a simple hierarchy for Perl 5 types, this
 could probably use some work, but it works for me at the moment.
 
   Any
+  
+  Item 
+      Undef
+      Defined
       Bool
       Value
           Int
diff --git a/t/060_moose_for_meta.t b/t/060_moose_for_meta.t
index de4c1d7..65326c8 100644
--- a/t/060_moose_for_meta.t
+++ b/t/060_moose_for_meta.t
@@ -3,13 +3,20 @@
 use strict;
 use warnings;
 
-use Test::More tests => 16;
+use Test::More tests => 17;
 use Test::Exception;
 
 BEGIN {
     use_ok('Moose');           
 }
 
+=pod
+
+This test demonstrates the ability to extend
+Moose meta-level classes using Moose itself.
+
+=cut
+
 {
     package My::Meta::Class;
     use strict;
@@ -17,6 +24,14 @@ BEGIN {
     use Moose;
     
     extends 'Moose::Meta::Class';
+    
+    around 'create_anon_class' => sub {
+        my $next = shift;
+        my ($self, %options) = @_;
+        $options{superclasses} = [ 'Moose::Object' ]
+            unless exists $options{superclasses};
+        $next->($self, %options);
+    };
 }
 
 my $anon = My::Meta::Class->create_anon_class();
@@ -24,6 +39,11 @@ isa_ok($anon, 'My::Meta::Class');
 isa_ok($anon, 'Moose::Meta::Class');
 isa_ok($anon, 'Class::MOP::Class');
 
+is_deeply(
+    [ $anon->superclasses ], 
+    [ 'Moose::Object' ], 
+    '... got the default superclasses');
+
 {
     package My::Meta::Attribute::DefaultReadOnly;
     use strict;
@@ -34,9 +54,10 @@ isa_ok($anon, 'Class::MOP::Class');
     
     around 'new' => sub {
         my $next = shift;
-        my $self = shift;
-        my $name = shift;
-        $next->($self, $name, (is => 'ro'), @_);
+        my ($self, $name, %options) = @_;
+        $options{is} = 'ro' 
+            unless exists $options{is};
+        $next->($self, $name, %options);
     };    
 }