embed.fnc: delimcpy_no_escape is now documented

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 5dee09d..40e9ae7 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -33,11 +33,16 @@
 #include "EXTERN.h"
 #define PERL_IN_PP_CTL_C
 #include "perl.h"
+#include "feature.h"
 
 #define RUN_PP_CATCHABLY(thispp) \
     STMT_START { if (CATCH_GET) return docatch(thispp); } STMT_END
 
-#define dopopto_cursub()       dopoptosub_at(cxstack, cxstack_ix)
+#define dopopto_cursub() \
+    (PL_curstackinfo->si_cxsubix >= 0        \
+        ? PL_curstackinfo->si_cxsubix        \
+        : dopoptosub_at(cxstack, cxstack_ix))
+
 #define dopoptosub(plop)       dopoptosub_at(cxstack, (plop))
 
 PP(pp_wantarray)
@@ -257,7 +262,7 @@ PP(pp_substcont)
                (void)SvPOK_only_UTF8(targ);
            }
 
-           /* update the taint state of various various variables in
+           /* update the taint state of various variables in
             * preparation for final exit.
             * See "how taint works" above pp_subst() */
            if (TAINTING_get) {
@@ -344,7 +349,7 @@ PP(pp_substcont)
     }
     if (old != rx)
        (void)ReREFCNT_inc(rx);
-    /* update the taint state of various various variables in preparation
+    /* update the taint state of various variables in preparation
      * for calling the code block.
      * See "how taint works" above pp_subst() */
     if (TAINTING_get) {
@@ -876,15 +881,12 @@ PP(pp_formline)
                 arg &= ~(FORM_NUM_POINT|FORM_NUM_BLANK);
 #ifdef USE_QUADMATH
                 {
-                    const char* qfmt = quadmath_format_single(fmt);
                     int len;
-                    if (!qfmt)
+                    if (!quadmath_format_valid(fmt))
                         Perl_croak_nocontext("panic: quadmath invalid format \"%s\"", fmt);
-                    len = quadmath_snprintf(t, max, qfmt, (int) fieldsize, (int) arg, value);
+                    len = quadmath_snprintf(t, max, fmt, (int) fieldsize, (int) arg, value);
                     if (len == -1)
-                        Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", qfmt);
-                    if (qfmt != fmt)
-                        Safefree(fmt);
+                        Perl_croak_nocontext("panic: quadmath_snprintf failed, format \"%s\"", fmt);
                 }
 #else
                 /* we generate fmt ourselves so it is safe */
@@ -1385,6 +1387,8 @@ Perl_dowantarray(pTHX)
     return (gimme == G_VOID) ? G_SCALAR : gimme;
 }
 
+/* note that this function has mostly been superseded by Perl_gimme_V */
+
 U8
 Perl_block_gimme(pTHX)
 {
@@ -2790,7 +2794,7 @@ S_check_op_type(pTHX_ OP * const o)
 
 PP(pp_goto)
 {
-    dVAR; dSP;
+    dSP;
     OP *retop = NULL;
     I32 ix;
     PERL_CONTEXT *cx;
@@ -2956,6 +2960,9 @@ PP(pp_goto)
                  * this is a cx_popblock(), less all the stuff we already did
                  * for cx_topblock() earlier */
                 PL_curcop = cx->blk_oldcop;
+                /* this is cx_popsub, less all the stuff we already did */
+                PL_curstackinfo->si_cxsubix = cx->blk_sub.old_cxsubix;
+
                 CX_POP(cx);
 
                /* Push a mark for the start of arglist */
@@ -3476,6 +3483,7 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh)
     if (clear_hints) {
        PL_hints = 0;
        hv_clear(GvHV(PL_hintgv));
+        CLEARFEATUREBITS();
     }
     else {
        PL_hints = saveop->op_private & OPpEVAL_COPHH
@@ -3493,6 +3501,7 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh)
            /* SAVEHINTS created a new HV in PL_hintgv, which we need to GC */
            SvREFCNT_dec(GvHV(PL_hintgv));
            GvHV(PL_hintgv) = hh;
+            FETCHFEATUREBITSHH(hh);
        }
     }
     SAVECOMPILEWARNINGS();
@@ -3743,7 +3752,7 @@ S_path_is_searchable(const char *name)
 static OP *
 S_require_version(pTHX_ SV *sv)
 {
-    dVAR; dSP;
+    dSP;
 
     sv = sv_2mortal(new_version(sv));
     if (!Perl_sv_derived_from_pvn(aTHX_ PL_patchlevel, STR_WITH_LEN("version"), 0))
@@ -3809,7 +3818,7 @@ S_require_version(pTHX_ SV *sv)
 static OP *
 S_require_file(pTHX_ SV *sv)
 {
-    dVAR; dSP;
+    dSP;
 
     PERL_CONTEXT *cx;
     const char *name;
@@ -3852,7 +3861,7 @@ S_require_file(pTHX_ SV *sv)
        if (op_is_require) {
                /* can optimize to only perform one single lookup */
                svp_cached = hv_fetch(GvHVn(PL_incgv), (char*) name, len, 0);
-               if ( svp_cached && *svp_cached != &PL_sv_undef ) RETPUSHYES;
+               if ( svp_cached && (SvGETMAGIC(*svp_cached), SvOK(*svp_cached)) ) RETPUSHYES;
        }
 #endif
 
@@ -3897,7 +3906,10 @@ S_require_file(pTHX_ SV *sv)
        /* reuse the previous hv_fetch result if possible */
        SV * const * const svp = svp_cached ? svp_cached : hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0);
        if ( svp ) {
-           if (*svp != &PL_sv_undef)
+            /* we already did a get magic if this was cached */
+            if (!svp_cached)
+                SvGETMAGIC(*svp);
+           if (SvOK(*svp))
                RETPUSHYES;
            else
                DIE(aTHX_ "Attempt to reload %s aborted.\n"
@@ -3964,7 +3976,7 @@ S_require_file(pTHX_ SV *sv)
     }
 
     /* ... but if we fail, still search @INC for code references;
-     * these are applied even on on-searchable paths (except
+     * these are applied even on non-searchable paths (except
      * if we got EACESS).
      *
      * For searchable paths, just search @INC normally
@@ -4133,18 +4145,6 @@ S_require_file(pTHX_ SV *sv)
                        continue;
                    sv_setpv(namesv, unixdir);
                    sv_catpv(namesv, unixname);
-#elif defined(__SYMBIAN32__)
-                   if (PL_origfilename[0] &&
-                       PL_origfilename[1] == ':' &&
-                       !(dir[0] && dir[1] == ':'))
-                       Perl_sv_setpvf(aTHX_ namesv,
-                                      "%c:%s\\%s",
-                                      PL_origfilename[0],
-                                      dir, name);
-                   else
-                       Perl_sv_setpvf(aTHX_ namesv,
-                                      "%s\\%s",
-                                      dir, name);
 #else
                    /* The equivalent of                    
                       Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name);