vcs.maemo.org Git - pkg-perl/blob - deb-src/libclass-accessor-perl/libclass-accessor-perl-0.31/t/aliases.t

   1 #!perl
   2 use strict;
   3 use Test::More tests => 36;
   4
   5 for my $class (qw(Class::Accessor Class::Accessor::Fast Class::Accessor::Faster)) {
   6     require_ok($class);
   7     my $silly = "Silly::$class";
   8     {
   9         no strict 'refs';
  10         @{"${silly}::ISA"} = ($class);
  11         *{"${silly}::accessor_name_for"} = sub { "read_$_[1]" };
  12         *{"${silly}::mutator_name_for"} = sub { "write_$_[1]" };
  13         $silly->mk_accessors(qw( foo ));
  14         $silly->mk_ro_accessors(qw(roro));
  15         $silly->mk_wo_accessors(qw(wowo));
  16     }
  17
  18     for my $f (qw/foo roro /) {
  19         ok $silly->can("read_$f"), "'read_$f' method exists";
  20     }
  21
  22     for my $f (qw/foo wowo/) {
  23         ok $silly->can("write_$f"), "'write_$f' method exists";
  24     }
  25
  26     for my $f (qw/foo roro wowo write_roro read_wowo/) {
  27         ok !$silly->can($f), "no '$f' method";
  28     }
  29
  30     my $test = $silly->new({
  31             foo => "bar",
  32             roro => "boat",
  33             wowo => "huh",
  34         });
  35
  36     is($test->read_foo, "bar", "initial foo");
  37     $test->write_foo("stuff");
  38     is($test->read_foo, "stuff", "new foo");
  39 }