t/cmop/LazyClass_test.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use File::Spec;
   6
   7 use Class::MOP;
   8
   9 BEGIN {
  10     require_ok(File::Spec->catfile('examples', 'LazyClass.pod'));
  11 }
  12
  13 {
  14     package BinaryTree;
  15
  16     use metaclass (
  17         'attribute_metaclass' => 'LazyClass::Attribute',
  18         'instance_metaclass'  => 'LazyClass::Instance',
  19     );
  20
  21     BinaryTree->meta->add_attribute('node' => (
  22         accessor => 'node',
  23         init_arg => 'node'
  24     ));
  25
  26     BinaryTree->meta->add_attribute('left' => (
  27         reader  => 'left',
  28         default => sub { BinaryTree->new() }
  29     ));
  30
  31     BinaryTree->meta->add_attribute('right' => (
  32         reader  => 'right',
  33         default => sub { BinaryTree->new() }
  34     ));
  35
  36     sub new {
  37         my $class = shift;
  38         bless $class->meta->new_object(@_) => $class;
  39     }
  40 }
  41
  42 my $root = BinaryTree->new('node' => 0);
  43 isa_ok($root, 'BinaryTree');
  44
  45 ok(exists($root->{'node'}), '... node attribute has been initialized yet');
  46 ok(!exists($root->{'left'}), '... left attribute has not been initialized yet');
  47 ok(!exists($root->{'right'}), '... right attribute has not been initialized yet');
  48
  49 isa_ok($root->left, 'BinaryTree');
  50 isa_ok($root->right, 'BinaryTree');
  51
  52 ok(exists($root->{'left'}), '... left attribute has now been initialized');
  53 ok(exists($root->{'right'}), '... right attribute has now been initialized');
  54
  55 ok(!exists($root->left->{'node'}), '... node attribute has not been initialized yet');
  56 ok(!exists($root->left->{'left'}), '... left attribute has not been initialized yet');
  57 ok(!exists($root->left->{'right'}), '... right attribute has not been initialized yet');
  58
  59 ok(!exists($root->right->{'node'}), '... node attribute has not been initialized yet');
  60 ok(!exists($root->right->{'left'}), '... left attribute has not been initialized yet');
  61 ok(!exists($root->right->{'right'}), '... right attribute has not been initialized yet');
  62
  63 is($root->left->node(), undef, '... the left node is uninitialized');
  64
  65 ok(exists($root->left->{'node'}), '... node attribute has now been initialized');
  66
  67 $root->left->node(1);
  68 is($root->left->node(), 1, '... the left node == 1');
  69
  70 ok(!exists($root->left->{'left'}), '... left attribute still has not been initialized yet');
  71 ok(!exists($root->left->{'right'}), '... right attribute still has not been initialized yet');
  72
  73 is($root->right->node(), undef, '... the right node is uninitialized');
  74
  75 ok(exists($root->right->{'node'}), '... node attribute has now been initialized');
  76
  77 $root->right->node(2);
  78 is($root->right->node(), 2, '... the right node == 1');
  79
  80 ok(!exists($root->right->{'left'}), '... left attribute still has not been initialized yet');
  81 ok(!exists($root->right->{'right'}), '... right attribute still has not been initialized yet');
  82
  83 done_testing;