| Subject: | Bug in Class::Std CUMULATIVE methods using shift(@_) |
There is a bug in how Class::Std handles CUMULATIVE methods that use shift on @_.
There's an idiom I use sometimes that revealed the problem:
sub method { shift->other_method('extra_info_to_pass_in' => @_) }
When Class::Std dispatches to two or more methods, the @_ is modified by the shift, so the second method will not get $self when shifting, but will instead get $_[1].
Attached is a failing test case that demonstraits the problem. It must be applied AFTER the patch I submitted for bug 13962 is applied.
--- t/cumulative.t~ 2005-08-01 13:42:04.000000000 -0700
+++ t/cumulative.t 2005-08-01 13:43:10.000000000 -0700
@@ -4,6 +4,7 @@
{
sub base_first :CUMULATIVE(BASE FIRST) { return __PACKAGE__ }
sub der_first :CUMULATIVE { return __PACKAGE__ }
+ sub shift_obj :CUMULATIVE { return shift }
}
package Base2;
@@ -11,6 +12,7 @@
{
sub base_first :CUMULATIVE(BASE FIRST) { return __PACKAGE__ }
sub der_first :CUMULATIVE { return __PACKAGE__ }
+ sub shift_obj :CUMULATIVE { return shift }
}
package Base3;
@@ -19,6 +21,7 @@
{
sub base_first :CUMULATIVE(BASE FIRST) { return __PACKAGE__ }
sub der_first :CUMULATIVE { return __PACKAGE__ }
+ sub shift_obj :CUMULATIVE { return shift }
}
package Base4;
@@ -26,6 +29,7 @@
{
sub base_first { return __PACKAGE__ }
sub der_first { return __PACKAGE__ }
+ sub shift_obj { return shift }
}
package Der1;
@@ -34,6 +38,7 @@
{
sub base_first :CUMULATIVE(BASE FIRST) { return __PACKAGE__ }
sub der_first :CUMULATIVE { return __PACKAGE__ }
+ sub shift_obj :CUMULATIVE { return shift }
}
package Der2;
@@ -42,6 +47,7 @@
{
sub base_first :CUMULATIVE(BASE FIRST) { return __PACKAGE__ }
sub der_first :CUMULATIVE { return __PACKAGE__ }
+ sub shift_obj :CUMULATIVE { return shift }
}
package Reder1;
@@ -50,11 +56,12 @@
{
sub base_first :CUMULATIVE(BASE FIRST) { return __PACKAGE__ }
sub der_first :CUMULATIVE { return __PACKAGE__ }
+ sub shift_obj :CUMULATIVE { return shift }
}
package main;
-use Test::More tests => 60;
+use Test::More tests => 62;
my $obj = Reder1->new();
@@ -64,9 +71,12 @@
my $up_string = join q{}, @up_order;
my $down_string = join q{}, @down_order;
+my @objs = ($obj) x 6;
+
for my $test_run (1..2) {
my $res_up = $obj->der_first();
my $res_down = $obj->base_first();
+ my $res_objs = $obj->shift_obj();
is int $res_up, int @up_order => 'Numeric cumulative up';
is int $res_down, int @down_order => 'Numeric cumulative down';
@@ -86,4 +96,6 @@
ok grep($classname, @down_order) => "Valid down hash key ($classname)";
is $classname, $res_up->{$classname} => "Valid down hash value ($classname)";
}
+
+ is_deeply \@$res_objs, \@objs => "shift(\@_) used in method";
}