t/106_LazyClass_test.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 26;
   7 use File::Spec;
   8
   9 BEGIN {
  10     use_ok('Class::MOP');
  11     require_ok(File::Spec->catdir('examples', 'LazyClass.pod'));
  12 }
  13
  14 {
  15     package BinaryTree;
  16
  17     use metaclass 'Class::MOP::Class' => (
  18         ':attribute_metaclass' => 'LazyClass::Attribute',
  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->construct_instance(@_) => $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