Handle __PACKAGE__ as object name correctly

__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.

diff --git a/indirect.xs b/indirect.xs
index 78788021af885ab2c1afaf3804c919fcd9e7f8f5..3bd5e6cef5addca2a46f23de0f07979c1152d5dc 100644 (file)
--- a/indirect.xs
+++ b/indirect.xs
@@ -576,6 +576,25 @@ STATIC OP *indirect_ck_const(pTHX_ OP *o) {
    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;
    }

diff --git a/t/20-good.t b/t/20-good.t
index d57de4f0cc009fe71835634ebbfa3f1790c410ff..f6fe90abfc61c7e3a7958361d9c6488c51e29d66 100644 (file)
--- a/t/20-good.t
+++ b/t/20-good.t
@@ -9,7 +9,7 @@ package main;
 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} }
 
@@ -441,3 +441,25 @@ sub {
  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__

diff --git a/t/21-bad.t b/t/21-bad.t
index fa2c322bda0254260f76e5372eef0f3c692064d4..0d3b48d96a3f81abe21a73e361595fc19e387381 100644 (file)
--- a/t/21-bad.t
+++ b/t/21-bad.t
@@ -11,8 +11,8 @@ use warnings;
 
 my ($tests, $reports);
 BEGIN {
- $tests   = 82;
- $reports = 94;
+ $tests   = 84;
+ $reports = 96;
 }
 
 use Test::More tests => 3 * (4 * $tests + $reports) + 4;
@@ -491,3 +491,13 @@ meh { feh $x; 1; } new Hlagh, feh $y;
 $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___' ]