The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

# vim:ts=2:sw=2:et:sta:syntax=perl

use strict;
use warnings;

use Test::More (
  'no_plan'
  );

BEGIN {use_ok('dtRdr::Accessor') or die};

ok(! __PACKAGE__->isa(__PACKAGE__ . '::--accessors'), 'safe to use()');
{
  package Bar;
  use dtRdr::Accessor;
}
ok(! Bar->isa('Bar::--accessors'), 'safe to use()');

# basic usage:
{
  package Foo;
  use dtRdr::Accessor(
    ro => [qw(fee fie foe)],
    rw => [qw(foo bar baz)],
  );
}
ok(Foo->isa('Foo::--accessors'), 'isa Foo::--accessors');
can_ok('Foo',
  map({$_, 'get_' . $_} qw(fee fie foe foo bar baz)),
  map({'set_' . $_} qw(foo bar baz))
);
ok(! Foo->can("set_$_"), "do not want set_$_") for qw(fee fie foe);

can_ok('dtRdr::Accessor', qw(ro rw));

# later usage
{
  package Deal;
  use dtRdr::Accessor;
  dtRdr::Accessor->ro(qw(a b c));
  dtRdr::Accessor->rw(qw(d e f));
}

ok(Deal->isa('Deal::--accessors'), 'isa Deal::--accessors');
can_ok('Deal',
  map({$_, 'get_' . $_} qw(a b c d e f)),
  map({'set_' . $_} qw(d e f))
);
ok(! Deal->can("set_$_"), "do not want set_$_") for qw(a b c);

{
my $secret_setter;
{
  package ClassifyMe;

  use dtRdr::Accessor;
  dtRdr::Accessor->class_ro(qw(a 1 b 2 c 3));
  dtRdr::Accessor->class_rw(qw(d 4 e 5 f 6));
  $secret_setter = dtRdr::Accessor->class_ro_w(g => 7);
}
ok(ClassifyMe->isa('ClassifyMe::--accessors'), 'isa ...--accessors');
can_ok('ClassifyMe',
  map({$_, 'get_' . $_} qw(a b c d e f g)),
  map({'set_' . $_} qw(d e f))
);
ok(! ClassifyMe->can('set_1'), 'cannot 1');
ok(! ClassifyMe->can('get_1'), 'cannot 1');
ok(! ClassifyMe->can('1'), 'cannot 1');
ok(! ClassifyMe->can("set_$_"), "do not want set_$_") for qw(a b c g);
ok(ClassifyMe->$_ == ord($_) - 96, "class data for $_") for qw(a b c d e f);
for(qw(d e f)) {
  my $setter = 'set_' . $_;
  ok(ClassifyMe->$setter(ord($_)), "set data for $_");
  ok(ClassifyMe->$_ == ord($_),    "setter check for $_");
}
ok(ClassifyMe->g == 7, 'bingo');
ok(ref($secret_setter), 'gots us a setter');
ok($secret_setter->(17));
ok(ClassifyMe->g == 17, 'ding!');
}

{
my $setter;
{
  package SecretSetter;
  use dtRdr::Accessor;
  dtRdr::Accessor->ro(qw(a b));
  dtRdr::Accessor->rw(qw(c d));
  $setter = dtRdr::Accessor->ro_w('e');
}
ok(SecretSetter->isa('SecretSetter::--accessors'), 'isa ...--accessors');
can_ok('SecretSetter',
  map({$_, 'get_' . $_} qw(a b c d e)),
  map({'set_' . $_} qw(c d))
);
ok(! SecretSetter->can("set_$_"), "do not want set_$_") for qw(a b e);
is($setter, '--set_e', 'got the name right');
ok(SecretSetter->can($setter), "has method $setter");
my $obj = SecretSetter->new;
ok($obj, 'constructor');
ok($obj->isa('SecretSetter'), 'isa ok');
ok(! defined($obj->c), 'nothing there yet');
$obj->set_c(5);
is($obj->c, 5, 'ordinary setter');
ok(! defined($obj->e), 'nothing there yet');
$obj->$setter(7);
is($obj->e, 7, 'setter worked');
}