pp_sys.c: don't hardcode socket address buffer size

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 064bdc0..13da72f 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -33,10 +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() \
+    (PL_curstackinfo->si_cxsubix >= 0        \
+        ? PL_curstackinfo->si_cxsubix        \
+        : dopoptosub_at(cxstack, cxstack_ix))
+
 #define dopoptosub(plop)       dopoptosub_at(cxstack, (plop))
 
 PP(pp_wantarray)
@@ -50,7 +56,7 @@ PP(pp_wantarray)
        if (!(cx = caller_cx(1,NULL))) RETPUSHUNDEF;
     }
     else {
-      cxix = dopoptosub(cxstack_ix);
+      cxix = dopopto_cursub();
       if (cxix < 0)
        RETPUSHUNDEF;
       cx = &cxstack[cxix];
@@ -875,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 */
@@ -1384,10 +1387,12 @@ 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)
 {
-    const I32 cxix = dopoptosub(cxstack_ix);
+    const I32 cxix = dopopto_cursub();
     U8 gimme;
     if (cxix < 0)
        return G_VOID;
@@ -1402,7 +1407,7 @@ Perl_block_gimme(pTHX)
 I32
 Perl_is_lvalue_sub(pTHX)
 {
-    const I32 cxix = dopoptosub(cxstack_ix);
+    const I32 cxix = dopopto_cursub();
     assert(cxix >= 0);  /* We should only be called from inside subs */
 
     if (CxLVAL(cxstack + cxix) && CvLVALUE(cxstack[cxix].blk_sub.cv))
@@ -1860,7 +1865,7 @@ frame for the sub call itself.
 const PERL_CONTEXT *
 Perl_caller_cx(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
 {
-    I32 cxix = dopoptosub(cxstack_ix);
+    I32 cxix = dopopto_cursub();
     const PERL_CONTEXT *cx;
     const PERL_CONTEXT *ccstack = cxstack;
     const PERL_SI *top_si = PL_curstackinfo;
@@ -2462,7 +2467,7 @@ PP(pp_return)
 {
     dSP; dMARK;
     PERL_CONTEXT *cx;
-    const I32 cxix = dopoptosub(cxstack_ix);
+    const I32 cxix = dopopto_cursub();
 
     assert(cxstack_ix >= 0);
     if (cxix < cxstack_ix) {
@@ -2833,7 +2838,7 @@ PP(pp_goto)
                DIE(aTHX_ "Goto undefined subroutine");
            }
 
-           cxix = dopoptosub(cxstack_ix);
+           cxix = dopopto_cursub();
             if (cxix < 0) {
                 DIE(aTHX_ "Can't goto subroutine outside a subroutine");
             }
@@ -2955,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 */
@@ -3475,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
@@ -3492,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();
@@ -3851,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
 
@@ -3896,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"