This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perldelta: update updated modules
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 15fe1af..c8b43f7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2489,7 +2489,7 @@ S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_op)
 /* info returned by S_sprintf_is_multiconcatable() */
 
 struct sprintf_ismc_info {
-    UV     nargs;     /* num of args to sprintf (not including the format) */
+    SSize_t nargs;    /* num of args to sprintf (not including the format) */
     char  *start;     /* start of raw format string */
     char  *end;       /* bytes after end of raw format string */
     STRLEN total_len; /* total length (in bytes) of format string, not
@@ -2517,7 +2517,7 @@ S_sprintf_is_multiconcatable(pTHX_ OP *o,struct sprintf_ismc_info *info)
     OP    *pm, *constop, *kid;
     SV    *sv;
     char  *s, *e, *p;
-    UV     nargs, nformats;
+    SSize_t nargs, nformats;
     STRLEN cur, total_len, variant;
     bool   utf8;
 
@@ -2660,8 +2660,8 @@ S_maybe_multiconcat(pTHX_ OP *o)
         STRLEN len;   /* ... len set to SvPV(..., len) */
     } *argp, *toparg, args[PERL_MULTICONCAT_MAXARG*2 + 1];
 
-    UV nargs  = 0;
-    UV nconst = 0;
+    SSize_t nargs  = 0;
+    SSize_t nconst = 0;
     STRLEN variant;
     bool utf8 = FALSE;
     bool kid_is_last = FALSE; /* most args will be the RHS kid of a concat op;
@@ -3043,7 +3043,7 @@ S_maybe_multiconcat(pTHX_ OP *o)
                          + ((nargs + 1) * (variant ? 2 : 1))
                         )
                     );
-    const_str = (char *)PerlMemShared_malloc(total_len);
+    const_str = (char *)PerlMemShared_malloc(total_len ? total_len : 1);
 
     /* Extract all the non-const expressions from the concat tree then
      * dispose of the old tree, e.g. convert the tree from this:
@@ -3095,14 +3095,14 @@ S_maybe_multiconcat(pTHX_ OP *o)
             if (*p == '%') {
                 p++;
                 if (*p != '%') {
-                    (lenp++)->size = q - oldq;
+                    (lenp++)->ssize = q - oldq;
                     oldq = q;
                     continue;
                 }
             }
             *q++ = *p;
         }
-        lenp->size = q - oldq;
+        lenp->ssize = q - oldq;
         assert((STRLEN)(q - const_str) == total_len);
 
         /* Attach all the args (i.e. the kids of the sprintf) to o (which
@@ -3123,7 +3123,7 @@ S_maybe_multiconcat(pTHX_ OP *o)
         p = const_str;
         lenp = aux + PERL_MULTICONCAT_IX_LENGTHS;
 
-        lenp->size = -1;
+        lenp->ssize = -1;
 
         /* Concatenate all const strings into const_str.
          * Note that args[] contains the RHS args in reverse order, so
@@ -3133,15 +3133,15 @@ S_maybe_multiconcat(pTHX_ OP *o)
         for (argp = toparg; argp >= args; argp--) {
             if (!argp->p)
                 /* not a const op */
-                (++lenp)->size = -1;
+                (++lenp)->ssize = -1;
             else {
                 STRLEN l = argp->len;
                 Copy(argp->p, p, l, char);
                 p += l;
-                if (lenp->size == -1)
-                    lenp->size = l;
+                if (lenp->ssize == -1)
+                    lenp->ssize = l;
                 else
-                    lenp->size += l;
+                    lenp->ssize += l;
             }
         }
 
@@ -3215,11 +3215,11 @@ S_maybe_multiconcat(pTHX_ OP *o)
 
     /* Populate the aux struct */
 
-    aux[PERL_MULTICONCAT_IX_NARGS].uv       = nargs;
+    aux[PERL_MULTICONCAT_IX_NARGS].ssize     = nargs;
     aux[PERL_MULTICONCAT_IX_PLAIN_PV].pv    = utf8 ? NULL : const_str;
-    aux[PERL_MULTICONCAT_IX_PLAIN_LEN].size = utf8 ?    0 : total_len;
+    aux[PERL_MULTICONCAT_IX_PLAIN_LEN].ssize = utf8 ?    0 : total_len;
     aux[PERL_MULTICONCAT_IX_UTF8_PV].pv     = const_str;
-    aux[PERL_MULTICONCAT_IX_UTF8_LEN].size  = total_len;
+    aux[PERL_MULTICONCAT_IX_UTF8_LEN].ssize  = total_len;
 
     /* if variant > 0, calculate a variant const string and lengths where
      * the utf8 version of the string will take 'variant' more bytes than
@@ -3231,19 +3231,19 @@ S_maybe_multiconcat(pTHX_ OP *o)
         UNOP_AUX_item  *lens = aux + PERL_MULTICONCAT_IX_LENGTHS;
         UNOP_AUX_item *ulens = lens + (nargs + 1);
         char             *up = (char*)PerlMemShared_malloc(ulen);
-        UV                 n;
+        SSize_t            n;
 
         aux[PERL_MULTICONCAT_IX_UTF8_PV].pv    = up;
-        aux[PERL_MULTICONCAT_IX_UTF8_LEN].size = ulen;
+        aux[PERL_MULTICONCAT_IX_UTF8_LEN].ssize = ulen;
 
         for (n = 0; n < (nargs + 1); n++) {
             SSize_t i;
             char * orig_up = up;
-            for (i = (lens++)->size; i > 0; i--) {
+            for (i = (lens++)->ssize; i > 0; i--) {
                 U8 c = *p++;
                 append_utf8_from_native_byte(c, (U8**)&up);
             }
-            (ulens++)->size = (i < 0) ? i : up - orig_up;
+            (ulens++)->ssize = (i < 0) ? i : up - orig_up;
         }
     }
 
@@ -7193,9 +7193,10 @@ Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
 
 Constructs, checks, and returns an op of any type that involves an
 embedded C-level pointer (PV).  C<type> is the opcode.  C<flags> gives
-the eight bits of C<op_flags>.  C<pv> supplies the C-level pointer, which
-must have been allocated using C<PerlMemShared_malloc>; the memory will
-be freed when the op is destroyed.
+the eight bits of C<op_flags>.  C<pv> supplies the C-level pointer.
+Depending on the op type, the memory referenced by C<pv> may be freed
+when the op is destroyed.  If the op is of a freeing type, C<pv> must
+have been allocated using C<PerlMemShared_malloc>.
 
 =cut
 */
@@ -9242,6 +9243,8 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 
     PERL_ARGS_ASSERT_NEWMYSUB;
 
+    PL_hints |= HINT_BLOCK_SCOPE;
+
     /* Find the pad slot for storing the new sub.
        We cannot use PL_comppad, as it is the pad owned by the new sub.  We
        need to look in CvOUTSIDE and find the pad belonging to the enclos-
@@ -12182,8 +12185,6 @@ Perl_ck_sort(pTHX_ OP *o)
            SV ** const svp = hv_fetchs(hinthv, "sort", FALSE);
            if (svp) {
                const I32 sorthints = (I32)SvIV(*svp);
-               if ((sorthints & HINT_SORT_QUICKSORT) != 0)
-                   o->op_private |= OPpSORT_QSORT;
                if ((sorthints & HINT_SORT_STABLE) != 0)
                    o->op_private |= OPpSORT_STABLE;
                if ((sorthints & HINT_SORT_UNSTABLE) != 0)
@@ -13382,7 +13383,7 @@ Perl_ck_substr(pTHX_ OP *o)
        if (kid->op_type == OP_NULL)
            kid = OpSIBLING(kid);
        if (kid)
-           kid->op_flags |= OPf_MOD;
+           op_lvalue(kid, o->op_type);
 
     }
     return o;