Allow bareword file handle as argument to chdir().

[p5sagit/p5-mst-13.2.git] / pad.c

diff --git a/pad.c b/pad.c
index df1b8f4..0b61c3c 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -1,6 +1,6 @@
 /*    pad.c
  *
- *    Copyright (C) 2002, 2003, 2004, 2005 by Larry Wall and others
+ *    Copyright (C) 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -132,6 +132,7 @@ can be OR'ed together:
 PADLIST *
 Perl_pad_new(pTHX_ int flags)
 {
+    dVAR;
     AV *padlist, *padname, *pad;
 
     ASSERT_CURPAD_LEGAL("pad_new");
@@ -179,7 +180,7 @@ Perl_pad_new(pTHX_ int flags)
        AvREIFY_only(a0);
     }
     else {
-       av_store(pad, 0, Nullsv);
+       av_store(pad, 0, NULL);
     }
 
     AvREAL_off(padlist);
@@ -228,6 +229,7 @@ taken)
 void
 Perl_pad_undef(pTHX_ CV* cv)
 {
+    dVAR;
     I32 ix;
     const PADLIST * const padlist = CvPADLIST(cv);
 
@@ -262,11 +264,11 @@ Perl_pad_undef(pTHX_ CV* cv)
                CV * const innercv = (CV*)curpad[ix];
                U32 inner_rc = SvREFCNT(innercv);
                assert(inner_rc);
-               namepad[ix] = Nullsv;
+               namepad[ix] = NULL;
                SvREFCNT_dec(namesv);
 
                if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
-                   curpad[ix] = Nullsv;
+                   curpad[ix] = NULL;
                    SvREFCNT_dec(innercv);
                    inner_rc--;
                }
@@ -282,7 +284,7 @@ Perl_pad_undef(pTHX_ CV* cv)
                        (void)SvREFCNT_inc(outercv);
                    }
                    else {
-                       CvOUTSIDE(innercv) = Nullcv;
+                       CvOUTSIDE(innercv) = NULL;
                    }
 
                }
@@ -297,7 +299,7 @@ Perl_pad_undef(pTHX_ CV* cv)
        if (!sv)
            continue;
        if (sv == (SV*)PL_comppad_name)
-           PL_comppad_name = Nullav;
+           PL_comppad_name = NULL;
        else if (sv == (SV*)PL_comppad) {
            PL_comppad = Null(PAD*);
            PL_curpad = Null(SV**);
@@ -329,8 +331,9 @@ If fake, it means we're cloning an existing entry
 PADOFFSET
 Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake)
 {
+    dVAR;
     const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
-    SV* const namesv = NEWSV(1102, 0);
+    SV* const namesv = newSV(0);
 
     ASSERT_CURPAD_ACTIVE("pad_add_name");
 
@@ -404,9 +407,11 @@ for a slot which has no name and no active value.
 PADOFFSET
 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 {
+    dVAR;
     SV *sv;
     I32 retval;
 
+    PERL_UNUSED_ARG(optype);
     ASSERT_CURPAD_ACTIVE("pad_alloc");
 
     if (AvARRAY(PL_comppad) != PL_curpad)
@@ -462,8 +467,9 @@ Add an anon code entry to the current compiling pad
 PADOFFSET
 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
 {
+    dVAR;
     PADOFFSET ix;
-    SV* const name = NEWSV(1106, 0);
+    SV* const name = newSV(0);
     sv_upgrade(name, SVt_PVNV);
     sv_setpvn(name, "&", 1);
     SvIV_set(name, -1);
@@ -503,6 +509,7 @@ C<is_our> indicates that the name to check is an 'our' declaration
 void
 Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
 {
+    dVAR;
     SV         **svp;
     PADOFFSET  top, off;
 
@@ -572,6 +579,7 @@ Returns the offset in the current pad, or NOT_IN_PAD on failure.
 PADOFFSET
 Perl_pad_findmy(pTHX_ const char *name)
 {
+    dVAR;
     SV *out_sv;
     int out_flags;
     I32 offset;
@@ -610,6 +618,7 @@ Perl_pad_findmy(pTHX_ const char *name)
 PADOFFSET
 Perl_find_rundefsvoffset(pTHX)
 {
+    dVAR;
     SV *out_sv;
     int out_flags;
     return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
@@ -656,6 +665,7 @@ STATIC PADOFFSET
 S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
        SV** out_capture, SV** out_name_sv, int *out_flags)
 {
+    dVAR;
     I32 offset, new_offset;
     SV *new_capture;
     SV **new_capturep;
@@ -726,7 +736,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 
                /* our ? */
                if ((SvFLAGS(*out_name_sv) & SVpad_OUR)) {
-                   *out_capture = Nullsv;
+                   *out_capture = NULL;
                    return offset;
                }
 
@@ -738,7 +748,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                    if (warn && ckWARN(WARN_CLOSURE))
                        Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
                            "Variable \"%s\" is not available", name);
-                   *out_capture = Nullsv;
+                   *out_capture = NULL;
                }
 
                /* real value */
@@ -777,7 +787,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                        if (ckWARN(WARN_CLOSURE))
                            Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
                                "Variable \"%s\" is not available", name);
-                       *out_capture = Nullsv;
+                       *out_capture = NULL;
                    }
                }
                if (!*out_capture) {
@@ -827,9 +837,9 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
        new_offset = pad_add_name(
            SvPVX_const(*out_name_sv),
            (SvFLAGS(*out_name_sv) & SVpad_TYPED)
-                   ? SvSTASH(*out_name_sv) : Nullhv,
+                   ? SvSTASH(*out_name_sv) : NULL,
            (SvFLAGS(*out_name_sv) & SVpad_OUR)
-                   ? GvSTASH(*out_name_sv) : Nullhv,
+                   ? GvSTASH(*out_name_sv) : NULL,
            1  /* fake */
        );
 
@@ -862,7 +872,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
     return new_offset;
 }
 
-               
+
+#ifdef DEBUGGING
 /*
 =for apidoc pad_sv
 
@@ -876,6 +887,7 @@ Use macro PAD_SV instead of calling this function directly.
 SV *
 Perl_pad_sv(pTHX_ PADOFFSET po)
 {
+    dVAR;
     ASSERT_CURPAD_ACTIVE("pad_sv");
 
     if (!po)
@@ -897,10 +909,10 @@ Use the macro PAD_SETSV() rather than calling this function directly.
 =cut
 */
 
-#ifdef DEBUGGING
 void
 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
 {
+    dVAR;
     ASSERT_CURPAD_ACTIVE("pad_setsv");
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
@@ -930,6 +942,7 @@ Update the pad compilation state variables on entry to a new block
 void
 Perl_pad_block_start(pTHX_ int full)
 {
+    dVAR;
     ASSERT_CURPAD_ACTIVE("pad_block_start");
     SAVEI32(PL_comppad_name_floor);
     PL_comppad_name_floor = AvFILLp(PL_comppad_name);
@@ -958,6 +971,7 @@ Perl_pad_block_start(pTHX_ int full)
 U32
 Perl_intro_my(pTHX)
 {
+    dVAR;
     SV **svp;
     I32 i;
 
@@ -999,6 +1013,7 @@ lexicals in this scope and warn of any lexicals that never got introduced.
 void
 Perl_pad_leavemy(pTHX)
 {
+    dVAR;
     I32 off;
     SV * const * const svp = AvARRAY(PL_comppad_name);
 
@@ -1044,6 +1059,7 @@ new one.
 void
 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
 {
+    dVAR;
     ASSERT_CURPAD_LEGAL("pad_swipe");
     if (!PL_curpad)
        return;
@@ -1065,7 +1081,7 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
     /* if pad tmps aren't shared between ops, then there's no need to
      * create a new tmp when an existing op is freed */
 #ifdef USE_BROKEN_PAD_RESET
-    PL_curpad[po] = NEWSV(1107,0);
+    PL_curpad[po] = newSV(0);
     SvPADTMP_on(PL_curpad[po]);
 #else
     PL_curpad[po] = &PL_sv_undef;
@@ -1092,6 +1108,7 @@ Mark all the current temporaries for reuse
 void
 Perl_pad_reset(pTHX)
 {
+    dVAR;
 #ifdef USE_BROKEN_PAD_RESET
     if (AvARRAY(PL_comppad) != PL_curpad)
        Perl_croak(aTHX_ "panic: pad_reset curpad");
@@ -1163,7 +1180,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 
     /* extend curpad to match namepad */
     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
-       av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
+       av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
 
     if (type == padtidy_SUBCLONE) {
        SV * const * const namep = AvARRAY(PL_comppad_name);
@@ -1179,12 +1196,12 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
             * pad are anonymous subs.
             * The rest are created anew during cloning.
             */
-           if (!((namesv = namep[ix]) != Nullsv &&
+           if (!((namesv = namep[ix]) != NULL &&
                  namesv != &PL_sv_undef &&
                   *SvPVX_const(namesv) == '&'))
            {
                SvREFCNT_dec(PL_curpad[ix]);
-               PL_curpad[ix] = Nullsv;
+               PL_curpad[ix] = NULL;
            }
        }
     }
@@ -1230,6 +1247,7 @@ Free the SV at offset po in the current pad.
 void
 Perl_pad_free(pTHX_ PADOFFSET po)
 {
+    dVAR;
     ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
        return;
@@ -1274,6 +1292,7 @@ Dump the contents of a padlist
 void
 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
 {
+    dVAR;
     const AV *pad_name;
     const AV *pad;
     SV **pname;
@@ -1295,7 +1314,7 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
         const SV *namesv = pname[ix];
        if (namesv && namesv == &PL_sv_undef) {
-           namesv = Nullsv;
+           namesv = NULL;
        }
        if (namesv) {
            if (SvFAKE(namesv))
@@ -1345,6 +1364,7 @@ dump the contents of a CV
 STATIC void
 S_cv_dump(pTHX_ const CV *cv, const char *title)
 {
+    dVAR;
     const CV * const outside = CvOUTSIDE(cv);
     AV* const padlist = CvPADLIST(cv);
 
@@ -1419,7 +1439,7 @@ Perl_cv_clone(pTHX_ CV *proto)
     ENTER;
     SAVESPTR(PL_compcv);
 
-    cv = PL_compcv = (CV*)NEWSV(1104, 0);
+    cv = PL_compcv = (CV*)newSV(0);
     sv_upgrade((SV *)cv, SvTYPE(proto));
     CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
     CvCLONED_on(cv);
@@ -1453,8 +1473,8 @@ Perl_cv_clone(pTHX_ CV *proto)
     outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
 
     for (ix = fpad; ix > 0; ix--) {
-       SV* const namesv = (ix <= fname) ? pname[ix] : Nullsv;
-       SV *sv = Nullsv;
+       SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
+       SV *sv = NULL;
        if (namesv && namesv != &PL_sv_undef) { /* lexical */
            if (SvFAKE(namesv)) {   /* lexical from outside? */
                sv = outpad[(I32)SvNVX(namesv)];
@@ -1464,7 +1484,7 @@ Perl_cv_clone(pTHX_ CV *proto)
                    if (ckWARN(WARN_CLOSURE))
                        Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
                            "Variable \"%s\" is not available", SvPVX_const(namesv));
-                   sv = Nullsv;
+                   sv = NULL;
                }
                else {
                    assert(!SvPADSTALE(sv));
@@ -1480,7 +1500,7 @@ Perl_cv_clone(pTHX_ CV *proto)
                 else if (sigil == '%')
                    sv = (SV*)newHV();
                else
-                   sv = NEWSV(0, 0);
+                   sv = newSV(0);
                SvPADMY_on(sv);
            }
        }
@@ -1488,7 +1508,7 @@ Perl_cv_clone(pTHX_ CV *proto)
            sv = SvREFCNT_inc(ppad[ix]);
        }
        else {
-           sv = NEWSV(0, 0);
+           sv = newSV(0);
            SvPADTMP_on(sv);
        }
        PL_curpad[ix] = sv;
@@ -1512,7 +1532,7 @@ Perl_cv_clone(pTHX_ CV *proto)
        SV* const const_sv = op_const_sv(CvSTART(cv), cv);
        if (const_sv) {
            SvREFCNT_dec(cv);
-           cv = newCONSTSUB(CvSTASH(proto), Nullch, const_sv);
+           cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
        }
        else {
            CvCONST_off(cv);
@@ -1536,6 +1556,7 @@ moved to a pre-existing CV struct.
 void
 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
 {
+    dVAR;
     I32 ix;
     AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
     AV * const comppad = (AV*)AvARRAY(padlist)[1];
@@ -1568,6 +1589,7 @@ the new pad an @_ in slot zero.
 void
 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 {
+    dVAR;
     if (depth <= AvFILLp(padlist))
        return;
 
@@ -1594,7 +1616,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
                    else if (sigil == '%')
                        sv = (SV*)newHV();
                    else
-                       sv = NEWSV(0, 0);
+                       sv = newSV(0);
                    av_store(newpad, ix, sv);
                    SvPADMY_on(sv);
                }
@@ -1604,7 +1626,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
            }
            else {
                /* save temporaries on recursion? */
-               SV * const sv = NEWSV(0, 0);
+               SV * const sv = newSV(0);
                av_store(newpad, ix, sv);
                SvPADTMP_on(sv);
            }
@@ -1623,11 +1645,12 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 HV *
 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
 {
+    dVAR;
     SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
     if ( SvFLAGS(*av) & SVpad_TYPED ) {
         return SvSTASH(*av);
     }
-    return Nullhv;
+    return NULL;
 }
 
 /*