Skip to content
Browse files

add tests and do default on exists

  • Loading branch information...
1 parent 581ff46 commit 649f8cd21ea585cf47ed58710111103c7f66696d @ingydotnet committed Sep 10, 2011
Showing with 130 additions and 51 deletions.
  1. +10 −0 Changes
  2. +20 −7 README
  3. +9 −16 lib/Mo.pm
  4. +15 −7 lib/Mo.pod
  5. +76 −21 t/test.t
View
10 Changes
@@ -1,4 +1,14 @@
---
+version: 0.14
+date:
+changes:
+- Make default called on exists rather than undef
+---
+version: 0.13
+date: Fri Sep 9 19:15:05 CEST 2011
+changes:
+- dams++ adds 'default' for 'has'
+---
version: 0.12
date: Fri Sep 9 07:52:13 CEST 2011
changes:
View
27 README
@@ -6,7 +6,13 @@ SYNOPSIS
use Mo;
extends 'Nothing';
- has 'something' => ( is => 'rw' );
+ has 'something' => (
+ is => 'rw',
+ default => sub {
+ my $self = shift;
+ $self->build_something;
+ },
+ );
sub BUILD {
my $self = shift;
@@ -36,15 +42,22 @@ FEATURES
"has"
Mo exports a "has" keyword, to generate accessors.
- These accessors support "get" and "set" operations. That's it.
-
- Any extra arguments after the name, are silently ignored.
+ These accessors support "get" and "set" operations and allows a
+ "default". That's it.
has 'name';
- has 'same' => ( is => 'ro' );
+ has 'name' => ( default => sub { 'Joe' } );
+
+ "has" takes arguments after the name. Here is what it currently
+ supports:
+
+ default
+ Should be a code reference. The object instance is passed in,
+ and it should return the default value for this attribute.
+ Default is always called lazily.
- This lets you switch from Moo to Mo and back, without having to
- change all your accessors.
+ Any other arguments are ignored. This lets you switch from Moo to Mo
+ and back, without having to change all your accessors.
"strict" and "warnings"
Mo turns on "use strict" and "use warnings".
View
25 lib/Mo.pm
@@ -1,17 +1,10 @@
-package Mo;
-require strict; require warnings;
-our $VERSION = '0.12';
+package Mo; require strict; require warnings;
+our $VERSION = '0.13';
sub import {
- strict->import; warnings->import;
- my $p = caller;
- @{$p.'::ISA'} = $_[0];
- *{$p.'::extends'} = sub { @{(caller).'::ISA'} = $_[0] };
- *{$p.'::has'} = sub {
- my ($n, %a) = @_;
- *{caller."::$n"} =
- sub {@_-1?$_[0]{$n}=$_[1]:$_[0]{$n}//=($a{default}//sub{})->($_[0])}
- };
-}
-sub new {
- my $s = bless { @_[1..$#_] }, $_[0]; $s->can('BUILD') && $s->BUILD; $s
-}
+ strict->import; warnings->import; my $p = caller; @{$p.'::ISA'} = $_[0];
+ *{$p.'::extends'} = sub {@{(caller).'::ISA'} = $_[0]};
+ *{$p.'::has'} = sub { my ($n, %a) = @_; *{(caller)."::$n"} = $a{default}
+ ? sub { $#_ ? ($_[0]{$n} = $_[1]) : (exists $_[0]{$n})
+ ? $_[0]{$n} : ($_[0]{$n} = $a{default}($_[0])) }
+ : sub { $#_ ? $_[0]{$n} = $_[1] : $_[0]{$n} } };
+} sub new { my $s = bless {@_[1..$#_]},$_[0];$s->can('BUILD') && $s->BUILD;$s}
View
22 lib/Mo.pod
@@ -10,7 +10,13 @@ Mo - Micro Objects. Mo is less.
use Mo;
extends 'Nothing';
- has 'something' => ( is => 'rw' );
+ has 'something' => (
+ is => 'rw',
+ default => sub {
+ my $self = shift;
+ $self->build_something;
+ },
+ );
sub BUILD {
my $self = shift;
@@ -34,7 +40,8 @@ This is what you get. Nothing Mo.
=item C<new> method
-Mo provides a C<new> object constructor. It will call the C<BUILD> method after creation if it C<can>.
+Mo provides a C<new> object constructor. It will call the C<BUILD> method
+after creation if it C<can>.
=item C<extends>
@@ -45,19 +52,20 @@ your default parent class, of course.
Mo exports a C<has> keyword, to generate accessors.
-These accessors support C<get> and C<set> operations. That's it.
+These accessors support C<get> and C<set> operations and allows a C<default>.
+That's it.
has 'name';
- has 'name' => ( default => sub { 'joe' } );
+ has 'name' => ( default => sub { 'Joe' } );
-has takes arguments after the name. Here is what it currently supports :
+C<has> takes arguments after the name. Here is what it currently supports:
=over
=item default
-Should be a code reference, takes in argument the object instance only, and
-should return the default value for this attribute.
+Should be a code reference. The object instance is passed in, and it should
+return the default value for this attribute. Default is always called lazily.
=back
View
97 t/test.t
@@ -1,18 +1,90 @@
-use Test::More tests => 11;
+use Test::More;
+plan tests => 37;
+
+#============
package Foo;
use Mo;
has 'this';
+#============
+package main;
+
+ok defined(&Foo::has), 'Mo exports has';
+ok defined(&Foo::extends), 'Mo exports extends';
+ok not(defined(&Foo::new)), 'Mo does not export new';
+ok 'Foo'->isa('Mo'), 'Foo isa Mo';
+is "@Foo::ISA", "Mo", '@Foo::ISA is Mo';
+ok 'Foo'->can('new'), 'Foo can new';
+ok 'Foo'->can('this'), 'Foo can this';
+
+my $f = 'Foo'->new;
+
+ok not(exists($f->{this})), 'this does not exist';
+ok not(defined($f->this)), 'this is not defined';
+
+$f->this("it");
+
+is $f->this, 'it', 'this is it';
+is $f->{this}, 'it', '{this} is it';
+
+$f->this("that");
+
+is $f->this, 'that', 'this is that';
+is $f->{this}, 'that', '{this} is that';
+
+$f->this(undef);
+
+ok not(defined($f->this)), 'this is not defined';
+ok not(defined($f->{this})), '{this} is not defined';
+
+#============
package Bar;
use Mo;
extends 'Foo';
has 'that';
-has plop => ( default => sub { 42 } );;
+has them => default => sub {[]};
+has plop => (
+ is => 'xy',
+ default => sub { my $self = shift; "plop: " . $self->that },
+);
has 'plip';
+#============
+package main;
+
+ok 'Bar'->isa('Mo'), 'Bar isa Mo';
+ok 'Bar'->isa('Foo'), 'Bar isa Foo';
+is "@Bar::ISA", 'Foo', '@Bar::ISA is Foo';
+ok 'Bar'->can('new'), 'Bar can new';
+ok 'Bar'->can('this'), 'Bar can this';
+ok 'Bar'->can('that'), 'Bar can that';
+ok 'Bar'->can('them'), 'Bar can them';
+
+my $b = Bar->new(
+ this => 'thing',
+ that => 'thong',
+);
+
+is ref($b), 'Bar', 'Object created';
+ok $b->isa('Foo'), 'Inheritance works';
+ok $b->isa('Mo'), 'Bar isa Mo since Foo isa Mo';
+is $b->this, 'thing', 'Read works in parent class';
+is $b->that, 'thong', 'Read works in current class';
+is ref($b->them), 'ARRAY', 'default works';
+is $b->plop, 'plop: thong', 'default works as a method call';
+$b->that("thung");
+$b->plop(undef);
+ok not(defined $b->plop), 'plop is undef';
+delete $b->{plop};
+is $b->plop, 'plop: thung', 'default works again';
+$b->that("thyng");
+is $b->plop, 'plop: thung', 'default works again';
+is $b->plip, undef, 'no default is undef';
+
+#============
package Baz;
use Mo;
@@ -23,6 +95,7 @@ sub BUILD {
$self->foo(5);
}
+#============
package Maz;
use Mo;
extends 'Baz';
@@ -35,26 +108,9 @@ sub BUILD {
$self->bar(7);
}
+#============
package main;
-my $bar = Bar->new(
- this => 'thing',
- that => 'thong',
-);
-
-is ref($bar), 'Bar', 'Object created';
-
-ok $bar->isa('Foo'), 'Inheritance works';
-
-is $bar->this, 'thing', 'Read works';
-is $bar->that, 'thong', 'Read works in parent class';
-is $bar->plop, 42, 'default works';
-is $bar->plip, undef, 'default works';
-
-$bar->this('thang');
-
-is $bar->this, 'thang', 'Write works';
-
my $baz = Baz->new;
is $baz->foo, 5, 'BUILD works';
@@ -63,4 +119,3 @@ my $maz = Maz->new;
is $_, 5, '$_ is untouched';
is $maz->foo, 5, 'BUILD works again';
is $maz->bar, 7, 'BUILD works in parent class';
-

0 comments on commit 649f8cd

Please sign in to comment.
Something went wrong with that request. Please try again.