From: Dave Rolsky Date: Tue, 5 Aug 2008 03:06:53 +0000 (+0000) Subject: Some of the test code was formatted very weirdly (tabs, wrong spacing, X-Git-Tag: 0_55_01~56 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fa2985bc5c2b0fa59ea04904e89a035bf18a5bc6;p=gitmo%2FMoose.git Some of the test code was formatted very weirdly (tabs, wrong spacing, etc), mostly the code copied verbatim from recipes. --- diff --git a/t/000_recipes/basics/001_point.t b/t/000_recipes/basics/001_point.t index 46dbf9c..cef1850 100644 --- a/t/000_recipes/basics/001_point.t +++ b/t/000_recipes/basics/001_point.t @@ -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); diff --git a/t/000_recipes/basics/002_bank_account.t b/t/000_recipes/basics/002_bank_account.t index 36c677b..ff318cc 100644 --- a/t/000_recipes/basics/002_bank_account.t +++ b/t/000_recipes/basics/002_bank_account.t @@ -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); diff --git a/t/000_recipes/basics/003_binary_tree.t b/t/000_recipes/basics/003_binary_tree.t index 0f85f95..ac03763 100644 --- a/t/000_recipes/basics/003_binary_tree.t +++ b/t/000_recipes/basics/003_binary_tree.t @@ -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'); diff --git a/t/000_recipes/basics/005_coercion.t b/t/000_recipes/basics/005_coercion.t index 773742b..7643abf 100644 --- a/t/000_recipes/basics/005_coercion.t +++ b/t/000_recipes/basics/005_coercion.t @@ -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; diff --git a/t/300_immutable/001_immutable_moose.t b/t/300_immutable/001_immutable_moose.t index 9d4e089..772337b 100644 --- a/t/300_immutable/001_immutable_moose.t +++ b/t/300_immutable/001_immutable_moose.t @@ -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"; }