1 BEGIN { chdir 't' if -d 't' };
5 use Test::More 'no_plan';
8 my $Class = 'Object::Accessor';
12 my $Object = $Class->new;
14 my $Allow = qr/^\d+$/;
15 my $Err_re = qr/is an invalid value for '$Acc'/;
16 my ($Ver_re) = map { qr/$_/ } quotemeta qq['$Acc' (<undef>) is invalid];
19 ### XXX this will break warning tests though if enabled
20 $Object::Accessor::DEBUG = $Object::Accessor::DEBUG = 1 if @ARGV;
24 { ok( $Object, "Object of '$Class' created" );
25 isa_ok( $Object, $Class );
28 ### create an accessor;
30 local $SIG{__WARN__} = sub { $warning .= "@_" };
32 ok( $Object->mk_accessors( { $Acc => $Allow } ),
33 "Accessor '$Acc' created" );
35 ok( $Object->can( $Acc ), " Can '$Acc'" );
36 ok(!$warning, " No warnings logged" );
37 is( $Object->ls_allow( $Acc ), $Allow,
38 " Proper allow handler stored" );
43 ### try to use the accessor
46 local $SIG{__WARN__} = sub { $warning .= "@_" };
48 ok( !$Object->$Acc( $0 ), "'$Acc' NOT set to '$0'" );
49 is( $Object->$Acc(), undef, " '$Acc' still holds '<undef>'" );
50 like( $warning, $Err_re, " Warnings logged" );
56 my $ok = $Object->mk_verify;
57 ok( !$ok, " Internal verify fails" );
58 like( $warning, $Ver_re, " Warning logged" );
65 local $SIG{__WARN__} = sub { $warning .= "@_" };
67 ok( $Object->$Acc( $$ ), "'$Acc' set to '$$'" );
68 is( $Object->$Acc(), $$, " '$Acc' still holds '$$'" );
69 ok(!$warning, " No warnings logged" );
74 my $ok = $Object->mk_verify;
75 ok( $ok, " Internal verify succeeds" );
76 ok( !$warning, " No warnings" );