more tests
Stevan Little [Mon, 6 Mar 2006 07:13:56 +0000 (07:13 +0000)]
lib/Moose.pm
t/001_basic.t
t/002_basic.t
t/003_basic.t [new file with mode: 0644]

index d060032..8813e6d 100644 (file)
@@ -35,8 +35,16 @@ sub import {
                ));
        });
 
-       $meta->alias_method('before' => sub { $meta->add_before_method_modifier(@_) });
-       $meta->alias_method('after'  => sub { $meta->add_after_method_modifier(@_)  }); 
+       $meta->alias_method('before' => sub { 
+               my $code = pop @_;
+               $meta->add_before_method_modifier($_, $code) for @_; 
+       });
+       
+       $meta->alias_method('after'  => sub { 
+               my $code = pop @_;
+               $meta->add_after_method_modifier($_, $code)  for @_;
+       });     
+       
        $meta->alias_method('around' => sub { $meta->add_around_method_modifier(@_) }); 
        
        $meta->superclasses('Moose::Object') 
index 36cf310..93fb3b7 100644 (file)
@@ -11,6 +11,8 @@ BEGIN {
 
 {
        package Point;
+       use strict;
+       use warnings;   
        use Moose;
        
        has '$.x' => (reader   => 'x');
@@ -23,6 +25,8 @@ BEGIN {
        }
        
        package Point3D;
+       use strict;
+       use warnings;
        use Moose;
        
        use base 'Point';
index b87883b..d3053e7 100644 (file)
@@ -12,6 +12,8 @@ BEGIN {
 
 {
     package BankAccount;
+       use strict;
+       use warnings;
     use Moose;
     
     has '$.balance' => (accessor => 'balance', default => 0);
@@ -30,6 +32,8 @@ BEGIN {
     }
 
        package CheckingAccount;
+       use strict;
+       use warnings;   
        use Moose;
 
        use base 'BankAccount';
diff --git a/t/003_basic.t b/t/003_basic.t
new file mode 100644 (file)
index 0000000..527cb8d
--- /dev/null
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 18;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose');           
+}
+
+{
+    package BinaryTree;
+    use strict;
+    use warnings;
+    use Moose;
+
+    has '$.parent' => (
+        predicate => 'has_parent',
+        accessor  => 'parent'
+    );
+
+    has '$.left' => (
+        predicate => 'has_left',         
+        accessor  => 'left',
+    );
+
+    has '$.right' => (
+        predicate => 'has_right',           
+        accessor  => 'right',
+    );
+
+    before 'right', 'left' => sub {
+        my ($self, $tree) = @_;
+           $tree->parent($self) if defined $tree;   
+       };
+}
+
+my $root = BinaryTree->new();
+isa_ok($root, 'BinaryTree');
+
+is($root->left, undef, '... no left node yet');
+is($root->right, undef, '... no right node yet');
+
+ok(!$root->has_left, '... no left node yet');
+ok(!$root->has_right, '... no right node yet');
+
+my $left = BinaryTree->new();
+isa_ok($left, 'BinaryTree');
+
+ok(!$left->has_parent, '... left does not have a parent');
+
+$root->left($left);
+
+is($root->left, $left, '... got a left node now (and it is $left)');
+ok($root->has_left, '... we have a left node now');
+
+ok($left->has_parent, '... lefts has a parent');
+is($left->parent, $root, '... lefts parent is the root');
+
+my $right = BinaryTree->new();
+isa_ok($right, 'BinaryTree');
+
+ok(!$right->has_parent, '... right does not have a parent');
+
+$root->right($right);
+
+is($root->right, $right, '... got a right node now (and it is $right)');
+ok($root->has_right, '... we have a right node now');
+
+ok($right->has_parent, '... rights has a parent');
+is($right->parent, $root, '... rights parent is the root');