This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix #56194 Regex: (((??{1 + $^N}))) behaves differently in 5.10.0 than in blead
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 28440e0..5103efb 100644 (file)
--- a/op.c
+++ b/op.c
@@ -785,8 +785,8 @@ Perl_op_refcnt_unlock(pTHX)
 
 #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
 
-OP *
-Perl_linklist(pTHX_ OP *o)
+static OP *
+S_linklist(pTHX_ OP *o)
 {
     OP *first;
 
@@ -817,8 +817,8 @@ Perl_linklist(pTHX_ OP *o)
     return o->op_next;
 }
 
-OP *
-Perl_scalarkids(pTHX_ OP *o)
+static OP *
+S_scalarkids(pTHX_ OP *o)
 {
     if (o && o->op_flags & OPf_KIDS) {
         OP *kid;
@@ -1205,8 +1205,8 @@ Perl_scalarvoid(pTHX_ OP *o)
     return o;
 }
 
-OP *
-Perl_listkids(pTHX_ OP *o)
+static OP *
+S_listkids(pTHX_ OP *o)
 {
     if (o && o->op_flags & OPf_KIDS) {
         OP *kid;
@@ -1293,8 +1293,8 @@ Perl_list(pTHX_ OP *o)
     return o;
 }
 
-OP *
-Perl_scalarseq(pTHX_ OP *o)
+static OP *
+S_scalarseq(pTHX_ OP *o)
 {
     dVAR;
     if (o) {
@@ -1766,8 +1766,8 @@ S_is_handle_constructor(const OP *o, I32 numargs)
     }
 }
 
-OP *
-Perl_refkids(pTHX_ OP *o, I32 type)
+static OP *
+S_refkids(pTHX_ OP *o, I32 type)
 {
     if (o && o->op_flags & OPf_KIDS) {
         OP *kid;
@@ -2338,8 +2338,7 @@ Perl_newPROG(pTHX_ OP *o)
 
        /* Register with debugger */
        if (PERLDB_INTER) {
-           CV * const cv
-               = Perl_get_cvn_flags(aTHX_ STR_WITH_LEN("DB::postponed"), 0);
+           CV * const cv = get_cvs("DB::postponed", 0);
            if (cv) {
                dSP;
                PUSHMARK(SP);
@@ -2426,8 +2425,8 @@ Perl_jmaybe(pTHX_ OP *o)
     return o;
 }
 
-OP *
-Perl_fold_constants(pTHX_ register OP *o)
+static OP *
+S_fold_constants(pTHX_ register OP *o)
 {
     dVAR;
     register OP * VOL curop;
@@ -2567,8 +2566,8 @@ Perl_fold_constants(pTHX_ register OP *o)
     return o;
 }
 
-OP *
-Perl_gen_constant_list(pTHX_ register OP *o)
+static OP *
+S_gen_constant_list(pTHX_ register OP *o)
 {
     dVAR;
     register OP *curop;
@@ -2981,8 +2980,8 @@ Perl_newNULLLIST(pTHX)
     return newOP(OP_STUB, 0);
 }
 
-OP *
-Perl_force_list(pTHX_ OP *o)
+static OP *
+S_force_list(pTHX_ OP *o)
 {
     if (!o || o->op_type != OP_LIST)
        o = newLISTOP(OP_LIST, 0, o, NULL);
@@ -3119,8 +3118,8 @@ static int uvcompare(const void *a, const void *b)
     return 0;
 }
 
-OP *
-Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
+static OP *
+S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 {
     dVAR;
     SV * const tstr = ((SVOP*)expr)->op_sv;
@@ -5959,14 +5958,11 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
     dVAR;
     CV* cv;
 #ifdef USE_ITHREADS
-    const char *const temp_p = CopFILE(PL_curcop);
-    const STRLEN len = temp_p ? strlen(temp_p) : 0;
+    const char *const file = CopFILE(PL_curcop);
 #else
     SV *const temp_sv = CopFILESV(PL_curcop);
-    STRLEN len;
-    const char *const temp_p = temp_sv ? SvPV_const(temp_sv, len) : NULL;
+    const char *const file = temp_sv ? SvPV_nolen_const(temp_sv) : NULL;
 #endif
-    char *const file = savepvn(temp_p, temp_p ? len : 0);
 
     ENTER;
 
@@ -5994,10 +5990,10 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
        and so doesn't get free()d.  (It's expected to be from the C pre-
        processor __FILE__ directive). But we need a dynamically allocated one,
        and we need it to get freed.  */
-    cv = newXS_flags(name, const_sv_xsub, file, "", XS_DYNAMIC_FILENAME);
+    cv = newXS_flags(name, const_sv_xsub, file ? file : "", "",
+                    XS_DYNAMIC_FILENAME);
     CvXSUBANY(cv).any_ptr = sv;
     CvCONST_on(cv);
-    Safefree(file);
 
 #ifdef USE_ITHREADS
     if (stash)
@@ -7647,14 +7643,15 @@ Perl_ck_return(pTHX_ OP *o)
     } else {
        for (; kid; kid = kid->op_sibling)
            if ((kid->op_type == OP_NULL)
-               && (kid->op_flags & OPf_SPECIAL)) {
+               && ((kid->op_flags & (OPf_SPECIAL|OPf_KIDS)) == (OPf_SPECIAL|OPf_KIDS))) {
                /* This is a do block */
-               OP *op = cUNOPx(kid)->op_first;
-               assert(op && (op->op_type == OP_LEAVE) && (op->op_flags & OPf_KIDS));
-               op = cUNOPx(op)->op_first;
-               assert(op->op_type == OP_ENTER && !(op->op_flags & OPf_SPECIAL));
-               /* Force the use of the caller's context */
-               op->op_flags |= OPf_SPECIAL;
+               OP *op = kUNOP->op_first;
+               if (op->op_type == OP_LEAVE && op->op_flags & OPf_KIDS) {
+                   op = cUNOPx(op)->op_first;
+                   assert(op->op_type == OP_ENTER && !(op->op_flags & OPf_SPECIAL));
+                   /* Force the use of the caller's context */
+                   op->op_flags |= OPf_SPECIAL;
+               }
            }
     }