Some of the test code was formatted very weirdly (tabs, wrong spacing,
Dave Rolsky [Tue, 5 Aug 2008 03:06:53 +0000 (03:06 +0000)]
etc), mostly the code copied verbatim from recipes.

t/000_recipes/basics/001_point.t
t/000_recipes/basics/002_bank_account.t
t/000_recipes/basics/003_binary_tree.t
t/000_recipes/basics/005_coercion.t
t/300_immutable/001_immutable_moose.t

index 46dbf9c..cef1850 100644 (file)
@@ -7,33 +7,35 @@ use Test::More tests => 57;
 use Test::Exception;
 
 {
-       package Point;  
-       use Moose;
-               
-       has 'x' => (isa => 'Int', is => 'ro');
-       has 'y' => (isa => 'Int', is => 'rw');
-       
-       sub clear {
-           my $self = shift;
-           $self->{x} = 0;
-           $self->y(0);    
-       }
-       
-       __PACKAGE__->meta->make_immutable(debug => 0);
-}{     
-       package Point3D;
-       use Moose;
-       
-       extends 'Point';
-       
-       has 'z' => (isa => 'Int');
-       
-       after 'clear' => sub {
-           my $self = shift;
-           $self->{z} = 0;
-       };
-       
-    __PACKAGE__->meta->make_immutable(debug => 0);
+    package Point;
+    use Moose;
+
+    has 'x' => ( isa => 'Int', is => 'ro' );
+    has 'y' => ( isa => 'Int', is => 'rw' );
+
+    sub clear {
+        my $self = shift;
+        $self->{x} = 0;
+        $self->y(0);
+    }
+
+    __PACKAGE__->meta->make_immutable( debug => 0 );
+}
+
+{
+    package Point3D;
+    use Moose;
+
+    extends 'Point';
+
+    has 'z' => ( isa => 'Int' );
+
+    after 'clear' => sub {
+        my $self = shift;
+        $self->{z} = 0;
+    };
+
+    __PACKAGE__->meta->make_immutable( debug => 0 );
 }
 
 my $point = Point->new(x => 1, y => 2);        
index 36c677b..ff318cc 100644 (file)
@@ -9,41 +9,43 @@ use Test::Exception;
 {
     package BankAccount;
     use Moose;
-    
-    has 'balance' => (isa => 'Num', is => 'rw', default => 0);
+
+    has 'balance' => ( isa => 'Num', is => 'rw', default => 0 );
 
     sub deposit {
-        my ($self, $amount) = @_;
-        $self->balance($self->balance + $amount);
+        my ( $self, $amount ) = @_;
+        $self->balance( $self->balance + $amount );
     }
-    
+
     sub withdraw {
-        my ($self, $amount) = @_;
+        my ( $self, $amount ) = @_;
         my $current_balance = $self->balance();
-        ($current_balance >= $amount)
+        ( $current_balance >= $amount )
             || confess "Account overdrawn";
-        $self->balance($current_balance - $amount);
+        $self->balance( $current_balance - $amount );
     }
-    
-       __PACKAGE__->meta->make_immutable(debug => 0);
-}{
-       package CheckingAccount;        
-       use Moose;
-
-       extends 'BankAccount';
-       
-    has 'overdraft_account' => (isa => 'BankAccount', is => 'rw');     
-
-       before 'withdraw' => sub {
-               my ($self, $amount) = @_;
-               my $overdraft_amount = $amount - $self->balance();
-               if ($self->overdraft_account && $overdraft_amount > 0) {
-                       $self->overdraft_account->withdraw($overdraft_amount);
-                       $self->deposit($overdraft_amount);
-               }
-       };
-
-       __PACKAGE__->meta->make_immutable(debug => 0);
+
+    __PACKAGE__->meta->make_immutable( debug => 0 );
+}
+
+{
+    package CheckingAccount;
+    use Moose;
+
+    extends 'BankAccount';
+
+    has 'overdraft_account' => ( isa => 'BankAccount', is => 'rw' );
+
+    before 'withdraw' => sub {
+        my ( $self, $amount ) = @_;
+        my $overdraft_amount = $amount - $self->balance();
+        if ( $self->overdraft_account && $overdraft_amount > 0 ) {
+            $self->overdraft_account->withdraw($overdraft_amount);
+            $self->deposit($overdraft_amount);
+        }
+    };
+
+    __PACKAGE__->meta->make_immutable( debug => 0 );
 }
 
 my $savings_account = BankAccount->new(balance => 250);
index 0f85f95..ac03763 100644 (file)
@@ -12,37 +12,37 @@ use Scalar::Util 'isweak';
     package BinaryTree;
     use Moose;
 
-    has 'node' => (is => 'rw', isa => 'Any');
+    has 'node' => ( is => 'rw', isa => 'Any' );
 
     has 'parent' => (
-               is        => 'rw',
-               isa       => 'BinaryTree',      
+        is        => 'rw',
+        isa       => 'BinaryTree',
         predicate => 'has_parent',
-               weak_ref  => 1,
+        weak_ref  => 1,
     );
 
     has 'left' => (
-               is        => 'rw',      
-               isa       => 'BinaryTree',              
-        predicate => 'has_left',  
+        is        => 'rw',
+        isa       => 'BinaryTree',
+        predicate => 'has_left',
         lazy      => 1,
-        default   => sub { BinaryTree->new(parent => $_[0]) },       
+        default   => sub { BinaryTree->new( parent => $_[0] ) },
     );
 
     has 'right' => (
-               is        => 'rw',      
-               isa       => 'BinaryTree',              
-        predicate => 'has_right',   
-        lazy      => 1,       
-        default   => sub { BinaryTree->new(parent => $_[0]) },       
+        is        => 'rw',
+        isa       => 'BinaryTree',
+        predicate => 'has_right',
+        lazy      => 1,
+        default   => sub { BinaryTree->new( parent => $_[0] ) },
     );
 
     before 'right', 'left' => sub {
-        my ($self, $tree) = @_;
-           $tree->parent($self) if defined $tree;   
-       };
-       
-    __PACKAGE__->meta->make_immutable(debug => 0);     
+        my ( $self, $tree ) = @_;
+        $tree->parent($self) if defined $tree;
+    };
+
+    __PACKAGE__->meta->make_immutable( debug => 0 );
 }
 
 my $root = BinaryTree->new(node => 'root');
index 773742b..7643abf 100644 (file)
@@ -14,51 +14,39 @@ BEGIN {
 use Test::Exception;
 
 {
-       package Request;
-       use Moose;
+    package Request;
+    use Moose;
     use Moose::Util::TypeConstraints;
-       
-       use HTTP::Headers  ();
-       use Params::Coerce ();
-       use URI            ();
-
-       subtype Header
-           => as Object
-           => where { $_->isa('HTTP::Headers') };
-
-       coerce Header
-           => from ArrayRef
-               => via { HTTP::Headers->new( @{ $_ } ) }
-           => from HashRef
-               => via { HTTP::Headers->new( %{ $_ } ) };
-
-       subtype Uri
-           => as Object
-           => where { $_->isa('URI') };
-
-       coerce Uri
-           => from Object
-               => via { $_->isa('URI') ? $_ : Params::Coerce::coerce( 'URI', $_ ) }
-           => from Str
-               => via { URI->new( $_, 'http' ) };
-
-       subtype Protocol
-           => as Str
-           => where { /^HTTP\/[0-9]\.[0-9]$/ };
-
-
-       has 'base'     => (is => 'rw', isa => 'Uri', coerce  => 1);
-       has 'url'      => (is => 'rw', isa => 'Uri', coerce  => 1);     
-       has 'method'   => (is => 'rw', isa => 'Str');   
-       has 'protocol' => (is => 'rw', isa => 'Protocol');              
-       has 'headers'  => (
-           is      => 'rw',
-           isa     => 'Header',
-           coerce  => 1,
-           default => sub { HTTP::Headers->new } 
+
+    use HTTP::Headers  ();
+    use Params::Coerce ();
+    use URI            ();
+
+    subtype Header => as Object => where { $_->isa('HTTP::Headers') };
+
+    coerce Header => from ArrayRef => via { HTTP::Headers->new( @{$_} ) } =>
+        from HashRef => via { HTTP::Headers->new( %{$_} ) };
+
+    subtype Uri => as Object => where { $_->isa('URI') };
+
+    coerce Uri => from Object =>
+        via { $_->isa('URI') ? $_ : Params::Coerce::coerce( 'URI', $_ ) } =>
+        from Str => via { URI->new( $_, 'http' ) };
+
+    subtype Protocol => as Str => where {/^HTTP\/[0-9]\.[0-9]$/};
+
+    has 'base' => ( is => 'rw', isa => 'Uri', coerce => 1 );
+    has 'url'  => ( is => 'rw', isa => 'Uri', coerce => 1 );
+    has 'method'   => ( is => 'rw', isa => 'Str' );
+    has 'protocol' => ( is => 'rw', isa => 'Protocol' );
+    has 'headers'  => (
+        is      => 'rw',
+        isa     => 'Header',
+        coerce  => 1,
+        default => sub { HTTP::Headers->new }
     );
-    
-    __PACKAGE__->meta->make_immutable(debug => 0);
+
+    __PACKAGE__->meta->make_immutable( debug => 0 );
 }
 
 my $r = Request->new;
index 9d4e089..772337b 100644 (file)
@@ -10,43 +10,48 @@ use Moose::Meta::Role;
 
 
 {
-  package FooRole;
-  our $VERSION = '0.01';
-  sub foo { 'FooRole::foo' }
+    package FooRole;
+    our $VERSION = '0.01';
+    sub foo {'FooRole::foo'}
 }
 
 {
-  package Foo;
-  use Moose;
-
-  #two checks because the inlined methods are different when
-  #there is a TC present.
-  has 'foos' => (is => 'ro', lazy_build => 1);
-  has 'bars' => (isa => 'Str', is => 'ro', lazy_build => 1);
-  has 'bazes' => (isa => 'Str', is => 'ro', builder => '_build_bazes');
-  sub _build_foos  { "many foos" }
-  sub _build_bars  { "many bars" }
-  sub _build_bazes { "many bazes" }
+    package Foo;
+    use Moose;
+
+    #two checks because the inlined methods are different when
+    #there is a TC present.
+    has 'foos' => ( is => 'ro', lazy_build => 1 );
+    has 'bars' => ( isa => 'Str', is => 'ro', lazy_build => 1 );
+    has 'bazes' => ( isa => 'Str', is => 'ro', builder => '_build_bazes' );
+    sub _build_foos  {"many foos"}
+    sub _build_bars  {"many bars"}
+    sub _build_bazes {"many bazes"}
 }
 
 {
-  my $foo_role = Moose::Meta::Role->initialize('FooRole');
-  my $meta = Foo->meta;
-
-  lives_ok{ Foo->new                    } "lazy_build works";
-  is(Foo->new->foos, 'many foos'        , "correct value for 'foos'  before inlining constructor");
-  is(Foo->new->bars, 'many bars'        , "correct value for 'bars'  before inlining constructor");
-  is(Foo->new->bazes, 'many bazes'      , "correct value for 'bazes' before inlining constructor");
-  lives_ok{ $meta->make_immutable       } "Foo is imutable";
-  lives_ok{ $meta->identifier           } "->identifier on metaclass lives";
-  dies_ok{  $meta->add_role($foo_role)  } "Add Role is locked";
-  lives_ok{ Foo->new                    } "Inlined constructor works with lazy_build";
-  is(Foo->new->foos, 'many foos'        , "correct value for 'foos'  after inlining constructor");
-  is(Foo->new->bars, 'many bars'        , "correct value for 'bars'  after inlining constructor");
-  is(Foo->new->bazes, 'many bazes'      , "correct value for 'bazes' after inlining constructor");
-  lives_ok{ $meta->make_mutable         } "Foo is mutable";
-  lives_ok{ $meta->add_role($foo_role)  } "Add Role is unlocked";
-
+    my $foo_role = Moose::Meta::Role->initialize('FooRole');
+    my $meta     = Foo->meta;
+
+    lives_ok { Foo->new } "lazy_build works";
+    is( Foo->new->foos, 'many foos',
+        "correct value for 'foos'  before inlining constructor" );
+    is( Foo->new->bars, 'many bars',
+        "correct value for 'bars'  before inlining constructor" );
+    is( Foo->new->bazes, 'many bazes',
+        "correct value for 'bazes' before inlining constructor" );
+    lives_ok { $meta->make_immutable } "Foo is imutable";
+    lives_ok { $meta->identifier } "->identifier on metaclass lives";
+    dies_ok { $meta->add_role($foo_role) } "Add Role is locked";
+    lives_ok { Foo->new } "Inlined constructor works with lazy_build";
+    is( Foo->new->foos, 'many foos',
+        "correct value for 'foos'  after inlining constructor" );
+    is( Foo->new->bars, 'many bars',
+        "correct value for 'bars'  after inlining constructor" );
+    is( Foo->new->bazes, 'many bazes',
+        "correct value for 'bazes' after inlining constructor" );
+    lives_ok { $meta->make_mutable } "Foo is mutable";
+    lives_ok { $meta->add_role($foo_role) } "Add Role is unlocked";
 
 }