| Subject: | Wrong value from accessor while in :Init sub |
The attached test shows that the accessor to the field 'flag' in the
Derived class does not return the correct value when called inside the
'_init : Init' method in the Base class.
In particular, I'm expecting the
Derived->new(flag => 1)
call to die, because the flag is set and this should trigger the
die 'object is flagged!' if $self->is_flagged();
line in Base class initialisator.
I tried to strip down the example to the very roots, bear with me if
it's still not much clean. All the code is inside a single file, but it
shows the same behaviour when I divide stuff into single files for
test.pl, Base.pm and Derived.pm.
I'm running perl v5.8.8 built for i686-linux.
Regards,
Flavio.
| Subject: | test.pl |
#!/usr/bin/perl
use strict;
use warnings;
use Test::More 'no_plan';
use Test::Exception;
throws_ok { Base->new(flag => 1) } qr/object\s+is\s+flagged!/mxsi,
'complains for flag set in Base class';
throws_ok { Derived->new() } qr/missing.*flag/mxsi,
'complains for missing parameter flag in Derived';
lives_ok { Derived->new(flag => 0) } 'lives with flag set to 0 in Derived';
my $object;
throws_ok { $object = Derived->new(flag => 1) }
qr/object\s+is\s+flagged!/mxsi, 'complains for flag set in Derived';
print 'object is ', ($object->is_flagged() ? '' : 'NOT '), "flagged\n";
BEGIN {
package Base;
{
use strict;
use warnings;
use Object::InsideOut;
sub _init : Init {
my $self = shift;
die 'object is flagged!' if $self->is_flagged();
return;
}
sub is_flagged { return 1; }
}
package Derived;
{
use strict;
use warnings;
use Object::InsideOut qw( Base );
my @flag : Field : Std(Name => 'flag', Private => 1)
: Arg(Name => 'flag', Mandatory => 1);
sub is_flagged {
my $self = shift;
return $self->get_flag();
}
}
} ## end BEGIN
__END__
poletti@PolettiX:~/sviluppo/perl/Object-InsideOut$ perl test.pl
ok 1 - complains for flag set in Base class
ok 2 - complains for missing parameter flag in Derived
ok 3 - lives with flag set to 0 in Derived
not ok 4 - complains for flag set in Derived
# Failed test 'complains for flag set in Derived'
# at test.pl line 17.
# expecting: Regexp ((?msix:object\s+is\s+flagged!))
# found: normal exit
object is flagged
1..4
# Looks like you failed 1 test of 4.