summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
inline | side by side (from parent 1:
faa0984)
__PACKAGE__ cannot appear as the object name for indirect calls, but it
can for direct ones. This could cause wrong reports of indirect calls
when the actual package name appeared later in the source, for instance
in a comment. This is fixed by looking for '__PACKAGE__' in the source
buffer when we already have a hit for the current package name, and by
keeping the first one of those two.
This fixes RT #88428.
STRLEN pos;
if (indirect_find(sv, PL_oldbufptr, &pos)) {
STRLEN pos;
if (indirect_find(sv, PL_oldbufptr, &pos)) {
+ STRLEN len;
+
+ /* If the constant is equal to the current package name, try to look for
+ * a "__PACKAGE__" coming before what we got. We only need to check this
+ * when we already had a match because __PACKAGE__ can only appear in
+ * direct method calls ("new __PACKAGE__" is a syntax error). */
+ len = SvCUR(sv);
+ if (len == HvNAMELEN_get(PL_curstash)
+ && memcmp(SvPVX(sv), HvNAME_get(PL_curstash), len) == 0) {
+ STRLEN pos_pkg;
+ SV *pkg = sv_newmortal();
+ sv_setpvn(pkg, "__PACKAGE__", sizeof("__PACKAGE__")-1);
+
+ if (indirect_find(pkg, PL_oldbufptr, &pos_pkg) && pos_pkg < pos) {
+ sv = pkg;
+ pos = pos_pkg;
+ }
+ }
+
indirect_map_store(o, pos, sv, CopLINE(&PL_compiling));
return o;
}
indirect_map_store(o, pos, sv, CopLINE(&PL_compiling));
return o;
}
use strict;
use warnings;
use strict;
use warnings;
-use Test::More tests => 112 * 8 + 10;
+use Test::More tests => 119 * 8 + 10;
BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
my $self = shift;
return $_[0] ? undef : $self->new;
}
my $self = shift;
return $_[0] ? undef : $self->new;
}
+####
+package Hurp;
+__PACKAGE__->new;
+####
+package Hurp;
+__PACKAGE__->new # Hurp
+####
+package Hurp;
+__PACKAGE__->new;
+# Hurp
+####
+package __PACKAGE_;
+__PACKAGE__->new # __PACKAGE_
+####
+package __PACKAGE_;
+__PACKAGE_->new # __PACKAGE__
+####
+package __PACKAGE___;
+__PACKAGE__->new # __PACKAGE___
+####
+package __PACKAGE___;
+__PACKAGE___->new # __PACKAGE__
my ($tests, $reports);
BEGIN {
my ($tests, $reports);
BEGIN {
- $tests = 82;
- $reports = 94;
+ $tests = 84;
+ $reports = 96;
}
use Test::More tests => 3 * (4 * $tests + $reports) + 4;
}
use Test::More tests => 3 * (4 * $tests + $reports) + 4;
$obj = "apple @{[new { feh $x; meh $y; 1 }]} pear"
----
[ 'feh', '$x' ], [ 'meh', '$y' ], [ 'new', '{' ]
$obj = "apple @{[new { feh $x; meh $y; 1 }]} pear"
----
[ 'feh', '$x' ], [ 'meh', '$y' ], [ 'new', '{' ]
+####
+package __PACKAGE_;
+new __PACKAGE_;
+----
+[ 'new', '__PACKAGE_' ]
+####
+package __PACKAGE___;
+new __PACKAGE___;
+----
+[ 'new', '__PACKAGE___' ]