2011-05-10 25 views
8

Considere estos casos dos utilización:¿Por qué no recibo una advertencia de Perl?

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

y

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

La primera produce una advertencia Variable will not stay shared, mientras que el segundo no lo hace. Parece que la variable no se comparte en ambos casos. ¿Por qué no hay ninguna advertencia en el segundo caso?

+1

¿Ha considerado usar cierres anónimos? my $ test2 = sub {print $ v; } ... luego llamar a & {$ test2}(); limitará el alcance del cierre a una llamada a través de la variable local que hace referencia a él. – Roboprog

+0

@Roboprog: sí, hacer que la subrutina interna sea anónima resuelve el problema. Me preguntaba por qué Perl actuó de manera diferente en esos casos. –

Respuesta

3

Parece que esto puede ser un error u omisión en el pragma warnings.

Añadiendo a la diversión, esta disposición da una advertencia diferente:

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

que advierte Variable "$x" is not available

Estas advertencias todas ellas proceden de la llamada pad_findlex() API definida en 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 } 

Parece que tiene que ver con si la almohadilla que contiene se lleva a cabo dentro de un CV o no, pero no estoy seguro de los detalles exactos.

Cuestiones relacionadas