From: Vincent Pit Date: Wed, 8 Jul 2009 14:07:24 +0000 (+0200) Subject: Fix "meth meth" not being correctly reported X-Git-Tag: v0.15~1 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=9856d89db33e335664cca6910de72b53e0e12763;p=perl%2Fmodules%2Findirect.git Fix "meth meth" not being correctly reported --- diff --git a/indirect.xs b/indirect.xs index 01b4a77..12e83d5 100644 --- a/indirect.xs +++ b/indirect.xs @@ -604,6 +604,16 @@ done: /* ... ck_entersub ......................................................... */ +STATIC int indirect_is_indirect(const indirect_op_info_t *moi, const indirect_op_info_t *ooi) { + if (moi->pos > ooi->pos) + return 0; + + if (moi->pos == ooi->pos) + return moi->len == ooi->len && !memcmp(moi->buf, ooi->buf, moi->len); + + return 1; +} + STATIC OP *(*indirect_old_ck_entersub)(pTHX_ OP *) = 0; STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { @@ -651,7 +661,7 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) { if (!(ooi && ooi->pos)) goto done; - if (moi->pos < ooi->pos) { + if (indirect_is_indirect(moi, ooi)) { SV *file; dSP; diff --git a/t/20-good.t b/t/20-good.t index d428d1f..88d8060 100644 --- a/t/20-good.t +++ b/t/20-good.t @@ -9,7 +9,7 @@ package main; use strict; use warnings; -use Test::More tests => 52 * 4; +use Test::More tests => 56 * 4; my ($obj, $pkg, $cb, $x, @a); our $y; @@ -86,6 +86,14 @@ $obj = Hlagh -> , bar => $obj ); #### +$obj = new->new; +#### +$obj = new->new; # new new +#### +$obj = new->newnew; +#### +$obj = newnew->new; +#### $obj = Hlagh->$cb; #### $obj = Hlagh->$cb(); diff --git a/t/21-bad.t b/t/21-bad.t index 3b9985f..1d2fab9 100644 --- a/t/21-bad.t +++ b/t/21-bad.t @@ -9,7 +9,7 @@ package main; use strict; use warnings; -use Test::More tests => 50 * 6 + 2; +use Test::More tests => 52 * 6 + 2; my ($obj, $x); our ($y, $bloop); @@ -17,9 +17,9 @@ our ($y, $bloop); sub expect { my ($pkg) = @_; qr/^warn:Indirect\s+call\s+of\s+method\s+ - "(?:new|meh|$pkg$pkg)" + "(?:new|meh|feh|$pkg$pkg)" \s+on\s+object\s+ - "(?:$pkg|newnew|\$(?:[xyz_\$]|(?:sploosh::)?sploosh|(?:main::)?bloop))" + "(?:$pkg|newnew|feh|\$(?:[xyz_\$]|(?:sploosh::)?sploosh|(?:main::)?bloop))" \s+at\s+\(eval\s+\d+\)\s+line\s+\d+ /x } @@ -196,6 +196,10 @@ $obj = new newnew; #### $obj = new newnew; # new newnew #### +$obj = feh feh; +#### +$obj = feh feh; # feh feh +#### new Hlagh (meh $x) #### Hlagh->new(meh $x)