Why am I not getting a warning from Perl?

Question

Consider these two use cases:

sub test1 {
    my $v = 1;
    sub test2 { print $v }
    # ...
}

and

for (0..3) {
    my $foo = $_; 
    sub test1 { print $foo }
    # ...
}

The first one produces a Variable will not stay shared warning, while the second doesn't. It seems that the variable is not shared in both cases. Why isn't there any warning in the second case?

Answer 1

It seems that this may be a bug or omission in the warnings pragma.

Adding to the fun, this arrangement gives a different warning:

BEGIN {*outer = sub {
    my $x;
    sub inner {$x}
}}

Which warns Variable "$x" is not available

These warnings all come from the pad_findlex() API call defined in pad.c.

 806 =for apidoc pad_findlex
 807 
 808 Find a named lexical anywhere in a chain of nested pads. Add fake entries
 809 in the inner pads if it's found in an outer one.
 810 
 811 Returns the offset in the bottom pad of the lex or the fake lex.
 812 cv is the CV in which to start the search, and seq is the current cop_seq
 813 to match against. If warn is true, print appropriate warnings.  The out_*
 814 vars return values, and so are pointers to where the returned values
 815 should be stored. out_capture, if non-null, requests that the innermost
 816 instance of the lexical is captured; out_name_sv is set to the innermost
 817 matched namesv or fake namesv; out_flags returns the flags normally
 818 associated with the IVX field of a fake namesv.
 819 
 820 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
 821 then comes back down, adding fake entries as it goes. It has to be this way
 822 because fake namesvs in anon protoypes have to store in xlow the index into
 823 the parent pad.
 824 
 825 =cut
 826 */
 827 
 828 /* the CV has finished being compiled. This is not a sufficient test for
 829  * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
 830 #define CvCOMPILED(cv)  CvROOT(cv)
 831 
 832 /* the CV does late binding of its lexicals */
 833 #define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
 834 
 835 
 836 STATIC PADOFFSET
 837 S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 838         SV** out_capture, SV** out_name_sv, int *out_flags)
 839 {
 840     dVAR;
 841     I32 offset, new_offset;
 842     SV *new_capture;
 843     SV **new_capturep;
 844     const AV * const padlist = CvPADLIST(cv);
 845 
 846     PERL_ARGS_ASSERT_PAD_FINDLEX;
 847 
 848     *out_flags = 0;
 849 
 850     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 851         "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
 852         PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
 853 
 854     /* first, search this pad */
 855 
 856     if (padlist) { /* not an undef CV */
 857         I32 fake_offset = 0;
 858         const AV * const nameav = MUTABLE_AV(AvARRAY(padlist)[0]);
 859         SV * const * const name_svp = AvARRAY(nameav);
 860 
 861         for (offset = AvFILLp(nameav); offset > 0; offset--) {
 862             const SV * const namesv = name_svp[offset];
 863             if (namesv && namesv != &PL_sv_undef
 864                     && strEQ(SvPVX_const(namesv), name))
 865             {
 866                 if (SvFAKE(namesv)) {
 867                     fake_offset = offset; /* in case we don't find a real one */
 868                     continue;
 869                 }
 870                 /* is seq within the range _LOW to _HIGH ?
 871                  * This is complicated by the fact that PL_cop_seqmax
 872                  * may have wrapped around at some point */
 873                 if (COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO)
 874                     continue; /* not yet introduced */
 875 
 876                 if (COP_SEQ_RANGE_HIGH(namesv) == PERL_PADSEQ_INTRO) {
 877                     /* in compiling scope */
 878                     if (
 879                         (seq >  COP_SEQ_RANGE_LOW(namesv))
 880                         ? (seq - COP_SEQ_RANGE_LOW(namesv) < (U32_MAX >> 1))
 881                         : (COP_SEQ_RANGE_LOW(namesv) - seq > (U32_MAX >> 1))
 882                     )
 883                        break;
 884                 }
 885                 else if (
 886                     (COP_SEQ_RANGE_LOW(namesv) > COP_SEQ_RANGE_HIGH(namesv))
 887                     ?
 888                         (  seq >  COP_SEQ_RANGE_LOW(namesv)
 889                         || seq <= COP_SEQ_RANGE_HIGH(namesv))
 890 
 891                     :    (  seq >  COP_SEQ_RANGE_LOW(namesv)
 892                          && seq <= COP_SEQ_RANGE_HIGH(namesv))
 893                 )
 894                 break;
 895             }
 896         }
 897 
 898         if (offset > 0 || fake_offset > 0 ) { /* a match! */
 899             if (offset > 0) { /* not fake */
 900                 fake_offset = 0;
 901                 *out_name_sv = name_svp[offset]; /* return the namesv */
 902 
 903                 /* set PAD_FAKELEX_MULTI if this lex can have multiple
 904                  * instances. For now, we just test !CvUNIQUE(cv), but
 905                  * ideally, we should detect my's declared within loops
 906                  * etc - this would allow a wider range of 'not stayed
 907                  * shared' warnings. We also treated already-compiled
 908                  * lexes as not multi as viewed from evals. */
 909 
 910                 *out_flags = CvANON(cv) ?
 911                         PAD_FAKELEX_ANON :
 912                             (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
 913                                 ? PAD_FAKELEX_MULTI : 0;
 914 
 915                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 916                     "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
 917                     PTR2UV(cv), (long)offset,
 918                     (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
 919                     (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));
 920             }
 921             else { /* fake match */
 922                 offset = fake_offset;
 923                 *out_name_sv = name_svp[offset]; /* return the namesv */
 924                 *out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);
 925                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 926                     "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
 927                     PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
 928                     (unsigned long) PARENT_PAD_INDEX(*out_name_sv) 
 929                 ));
 930             }
 931 
 932             /* return the lex? */
 933 
 934             if (out_capture) {
 935 
 936                 /* our ? */
 937                 if (SvPAD_OUR(*out_name_sv)) {
 938                     *out_capture = NULL;
 939                     return offset;
 940                 }
 941 
 942                 /* trying to capture from an anon prototype? */
 943                 if (CvCOMPILED(cv)
 944                         ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
 945                         : *out_flags & PAD_FAKELEX_ANON)
 946                 {
 947                     if (warn)
 948                         Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
 949                                        "Variable \"%s\" is not available", name);
 950                     *out_capture = NULL;
 951                 }
 952 
 953                 /* real value */
 954                 else {
 955                     int newwarn = warn;
 956                     if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
 957                          && !SvPAD_STATE(name_svp[offset])
 958                          && warn && ckWARN(WARN_CLOSURE)) {
 959                         newwarn = 0;
 960                         Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
 961                             "Variable \"%s\" will not stay shared", name);
 962                     }
 963 
 964                     if (fake_offset && CvANON(cv)
 965                             && CvCLONE(cv) &&!CvCLONED(cv))
 966                     {
 967                         SV *n;
 968                         /* not yet caught - look further up */
 969                         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 970                             "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
 971                             PTR2UV(cv)));
 972                         n = *out_name_sv;
 973                         (void) pad_findlex(name, CvOUTSIDE(cv),
 974                             CvOUTSIDE_SEQ(cv),
 975                             newwarn, out_capture, out_name_sv, out_flags);
 976                         *out_name_sv = n;
 977                         return offset;
 978                     }
 979 
 980                     *out_capture = AvARRAY(MUTABLE_AV(AvARRAY(padlist)[
 981                                     CvDEPTH(cv) ? CvDEPTH(cv) : 1]))[offset];
 982                     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 983                         "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
 984                         PTR2UV(cv), PTR2UV(*out_capture)));
 985 
 986                     if (SvPADSTALE(*out_capture)
 987                         && !SvPAD_STATE(name_svp[offset]))
 988                     {
 989                         Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
 990                                        "Variable \"%s\" is not available", name);
 991                         *out_capture = NULL;
 992                     }
 993                 }
 994                 if (!*out_capture) {
 995                     if (*name == '@')
 996                         *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
 997                     else if (*name == '%')
 998                         *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
 999                     else
1000                         *out_capture = sv_newmortal();
1001                 }
1002             }
1003 
1004             return offset;
1005         }
1006     }
1007 
1008     /* it's not in this pad - try above */
1009 
1010     if (!CvOUTSIDE(cv))
1011         return NOT_IN_PAD;
1012 
1013     /* out_capture non-null means caller wants us to capture lex; in
1014      * addition we capture ourselves unless it's an ANON/format */
1015     new_capturep = out_capture ? out_capture :
1016                 CvLATE(cv) ? NULL : &new_capture;
1017 
1018     offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
1019                 new_capturep, out_name_sv, out_flags);
1020     if ((PADOFFSET)offset == NOT_IN_PAD)
1021         return NOT_IN_PAD;
1022 
1023     /* found in an outer CV. Add appropriate fake entry to this pad */
1024 
1025     /* don't add new fake entries (via eval) to CVs that we have already
1026      * finished compiling, or to undef CVs */
1027     if (CvCOMPILED(cv) || !padlist)
1028         return 0; /* this dummy (and invalid) value isnt used by the caller */
1029 
1030     {
1031         /* This relies on sv_setsv_flags() upgrading the destination to the same
1032            type as the source, independent of the flags set, and on it being
1033            "good" and only copying flag bits and pointers that it understands.
1034         */
1035         SV *new_namesv = newSVsv(*out_name_sv);
1036         AV *  const ocomppad_name = PL_comppad_name;
1037         PAD * const ocomppad = PL_comppad;
1038         PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
1039         PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
1040         PL_curpad = AvARRAY(PL_comppad);
1041 
1042         new_offset
1043             = pad_add_name_sv(new_namesv,
1044                               (SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
1045                               SvPAD_TYPED(*out_name_sv)
1046                               ? SvSTASH(*out_name_sv) : NULL,
1047                               SvOURSTASH(*out_name_sv)
1048                               );
1049 
1050         SvFAKE_on(new_namesv);
1051         DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1052                                "Pad addname: %ld \"%.*s\" FAKE\n",
1053                                (long)new_offset,
1054                                (int) SvCUR(new_namesv), SvPVX(new_namesv)));
1055         PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
1056 
1057         PARENT_PAD_INDEX_set(new_namesv, 0);
1058         if (SvPAD_OUR(new_namesv)) {
1059             NOOP;   /* do nothing */
1060         }
1061         else if (CvLATE(cv)) {
1062             /* delayed creation - just note the offset within parent pad */
1063             PARENT_PAD_INDEX_set(new_namesv, offset);
1064             CvCLONE_on(cv);
1065         }
1066         else {
1067             /* immediate creation - capture outer value right now */
1068             av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
1069             DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1070                 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
1071                 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
1072         }
1073         *out_name_sv = new_namesv;
1074         *out_flags = PARENT_FAKELEX_FLAGS(new_namesv);
1075 
1076         PL_comppad_name = ocomppad_name;
1077         PL_comppad = ocomppad;
1078         PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
1079     }
1080     return new_offset;
1081 }

It seems it has to do with if the containing pad is held within a CV or not, but I am not sure of the exact specifics.