Resolve TODO: Mouse::Util::TypeConstraints->unimport works
[gitmo/Mouse.git] / t / 044-attribute-metaclass.t
index 71fdd11..4c0c38d 100644 (file)
@@ -1,11 +1,11 @@
 #!/usr/bin/env perl
 use strict;
 use warnings;
-use Test::More tests => 5;
+use Test::More tests => 7;
 use lib 't/lib';
 
 do {
-    # copied from  MouseX::AttributeHelpers;
+    # copied from  MooseX::AttributeHelpers;
     package MouseX::AttributeHelpers::Trait::Base;
     use Mouse::Role;
     use Mouse::Util::TypeConstraints;
@@ -56,8 +56,8 @@ do {
 
     # extend the parents stuff to make sure
     # certain bits are now required ...
-    #has '+default'         => (required => 1);
-    #has '+type_constraint' => (required => 1);
+    #has 'default'         => (required => 1);
+    has 'type_constraint' => (is => 'rw', required => 1);
 
     ## Methods called prior to instantiation
 
@@ -131,8 +131,8 @@ do {
         # grab the reader and writer methods
         # as well, this will be useful for
         # our method provider constructors
-        my $attr_reader = $attr->get_read_method;
-        my $attr_writer = $attr->get_write_method;
+        my $attr_reader = $attr->get_read_method_ref;
+        my $attr_writer = $attr->get_write_method_ref;
 
 
         # before we install them, lets
@@ -203,43 +203,48 @@ do {
 
     sub helper_type { 'Num' }
 
-    has 'method_constructors' => (
-        is      => 'ro',
-        isa     => 'HashRef',
-        lazy    => 1,
-        default => sub {
-            return +{
-                set => sub {
-                    my ($attr, $reader, $writer) = @_;
-                    return sub { $_[0]->$writer($_[1]) };
-                },
-                add => sub {
-                    my ($attr, $reader, $writer) = @_;
-                    return sub { $_[0]->$writer($_[0]->$reader() + $_[1]) };
-                },
-                sub => sub {
-                    my ($attr, $reader, $writer) = @_;
-                    return sub { $_[0]->$writer($_[0]->$reader() - $_[1]) };
+    has 'method_constructors' => (\r
+        is      => 'ro',\r
+        isa     => 'HashRef',\r
+        lazy    => 1,\r
+        default => sub {\r
+            return +{\r
+                set => sub {\r
+                    my ( $attr, $reader, $writer ) = @_;\r
+                    return sub { $writer->( $_[0], $_[1] ) };\r
                 },
-                mul => sub {
-                    my ($attr, $reader, $writer) = @_;
-                    return sub { $_[0]->$writer($_[0]->$reader() * $_[1]) };
+                get => sub {\r
+                    my ( $attr, $reader, $writer ) = @_;\r
+                    return sub { $reader->( $_[0] ) };\r
                 },
-                div => sub {
-                    my ($attr, $reader, $writer) = @_;
-                    return sub { $_[0]->$writer($_[0]->$reader() / $_[1]) };
-                },
-                mod => sub {
-                    my ($attr, $reader, $writer) = @_;
-                    return sub { $_[0]->$writer($_[0]->$reader() % $_[1]) };
-                },
-                abs => sub {
-                    my ($attr, $reader, $writer) = @_;
-                    return sub { $_[0]->$writer(abs($_[0]->$reader()) ) };
-                },
-            }
-        }
-    );
+                add => sub {\r
+                    my ( $attr, $reader, $writer ) = @_;\r
+                    return sub { $writer->( $_[0], $reader->( $_[0] ) + $_[1] ) };\r
+                },\r
+                sub => sub {\r
+                    my ( $attr, $reader, $writer ) = @_;\r
+                    return sub { $writer->( $_[0], $reader->( $_[0] ) - $_[1] ) };\r
+                },\r
+                mul => sub {\r
+                    my ( $attr, $reader, $writer ) = @_;\r
+                    return sub { $writer->( $_[0], $reader->( $_[0] ) * $_[1] ) };\r
+                },\r
+                div => sub {\r
+                    my ( $attr, $reader, $writer ) = @_;\r
+                    return sub { $writer->( $_[0], $reader->( $_[0] ) / $_[1] ) };\r
+                },\r
+                mod => sub {\r
+                    my ( $attr, $reader, $writer ) = @_;\r
+                    return sub { $writer->( $_[0], $reader->( $_[0] ) % $_[1] ) };\r
+                },\r
+                abs => sub {\r
+                    my ( $attr, $reader, $writer ) = @_;\r
+                    return sub { $writer->( $_[0], abs( $reader->( $_[0] ) ) ) };\r
+                },\r
+            };\r
+        }\r
+    );\r
+\r
 
     package MouseX::AttributeHelpers::Number;
     use Mouse;
@@ -273,11 +278,14 @@ do {
     use Mouse;
 
     has 'ii' => (
-        is  => 'rw',
         isa => 'Num',
+        predicate => 'has_ii',
+
         provides => {
             sub => 'ii_minus',
             abs => 'ii_abs',
+            get => 'get_ii',
+            set => 'set_ii',
        },
 
        traits => [qw(MyNumber)],
@@ -293,6 +301,12 @@ can_ok 'MyClassWithTraits', qw(ii_minus ii_abs);
 
 $k = MyClassWithTraits->new(ii => 10);
 $k->ii_minus(100);
-is $k->ii,    -90;
-is $k->ii_abs, 90;
+is $k->get_ii, -90;
+$k->ii_abs;
+is $k->get_ii,  90;
+
+$k->set_ii(10);
+is $k->get_ii, 10;
+$k->ii_abs;
+is $k->get_ii, 10;