lib/Object/Accessor/t/01_Object-Accessor-Subclassed.t

   1 BEGIN { chdir 't' if -d 't' };
   2
   3 use strict;
   4 use lib '../lib';
   5 use Test::More 'no_plan';
   6 use Data::Dumper;
   7
   8 my $Class   = 'Object::Accessor';
   9 my $MyClass = 'My::Class';
  10 my $Acc     = 'foo';
  11
  12 use_ok($Class);
  13
  14 ### establish another package that subclasses our own
  15 {   package My::Class;
  16     use base 'Object::Accessor';
  17 }
  18
  19 my $Object  = $MyClass->new;
  20
  21 ### check the object
  22 {   ok( $Object,                "Object created" );
  23     isa_ok( $Object,            $MyClass );
  24     isa_ok( $Object,            $Class );
  25 }
  26
  27 ### create an accessor
  28 {   ok( $Object->mk_accessors( $Acc ),
  29                                 "Accessor '$Acc' created" );
  30     ok( $Object->can( $Acc ),   "   Object can '$Acc'" );
  31     ok( $Object->$Acc(1),       "   Objects '$Acc' set" );
  32     ok( $Object->$Acc(),        "   Objects '$Acc' retrieved" );
  33 }
  34
  35 ### check if we do the right thing when we call an accessor that's
  36 ### not a defined function in the base class, and not an accessors
  37 ### in the object either
  38 {   my $sub = eval { $MyClass->can( $$ ); };
  39
  40     ok( !$sub,                  "No sub from non-existing function" );
  41     ok( !$@,                    "   Code handled it gracefully" );
  42 }
  43
  44 ### check if a method called on a class, that's not actually there
  45 ### doesn't get confused as an object call;
  46 {   eval { $MyClass->$$ };
  47
  48     ok( $@,                     "Calling '$$' on '$MyClass' dies" );
  49     like( $@, qr/from somewhere else/,
  50                                 "   Dies with an informative message" );
  51 }