add tests and do default on exists

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:

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".

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}

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
 

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';
-