This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Exclude lex sub package name from (caller $n)[3]
authorFather Chrysostomos <sprout@cpan.org>
Tue, 16 Sep 2014 05:27:05 +0000 (22:27 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 16 Sep 2014 05:32:33 +0000 (22:32 -0700)
Commit ae77754ae caused it to start including the package name.  Pre-
viously, lexical subs were reported as ‘(unknown)’.

Now we have more expected output:

$ ./perl -Ilib -XMfeature=:all -e 'my sub x{warn +(caller 0)[3]} x'
x at -e line 1.

pp_ctl.c
t/op/lexsub.t

index 108643e..4ceca53 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1806,12 +1806,9 @@ PP(pp_caller)
     if (!has_arg)
        RETURN;
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
-       GV * const cvgv = CvGV(dbcx->blk_sub.cv);
        /* So is ccstack[dbcxix]. */
-       if (cvgv && isGV(cvgv)) {
-           SV * const sv = newSV(0);
-           gv_efullname3(sv, cvgv, NULL);
-           mPUSHs(sv);
+       if (CvHASGV(dbcx->blk_sub.cv)) {
+           PUSHs(cv_name(dbcx->blk_sub.cv, 0));
            PUSHs(boolSV(CxHASARGS(cx)));
        }
        else {
index d2edb79..966aa07 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     *bar::is = *is;
     *bar::like = *like;
 }
-plan 135;
+plan 137;
 
 # -------------------- Errors with feature disabled -------------------- #
 
@@ -380,6 +380,10 @@ like runperl(
 is runperl(switches => ['-lXMfeature=:all'],
            prog     => 'state sub x {}; undef &x; print defined &x',
            stderr   => 1), "\n", 'undefining state sub';
+{
+  state sub x { is +(caller 0)[3], 'x', 'state sub name in caller' }
+  x
+}
 
 # -------------------- my -------------------- #
 
@@ -727,6 +731,10 @@ pass "pad taking ownership once more of packagified my-sub";
 is runperl(switches => ['-lXMfeature=:all'],
            prog     => 'my sub x {}; undef &x; print defined &x',
            stderr   => 1), "\n", 'undefining my sub';
+{
+  my sub x { is +(caller 0)[3], 'x', 'my sub name in caller' }
+  x
+}
 
 # -------------------- Interactions (and misc tests) -------------------- #