lib/Unicode/UCD.t: Fix to work on older Unicodes

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index 3ee4818..1094510 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -76,7 +76,8 @@ PP(pp_null)
     return NORMAL;
 }
 
-/* This is sometimes called directly by pp_coreargs and pp_grepstart. */
+/* This is sometimes called directly by pp_coreargs, pp_grepstart and
+   amagic_call. */
 PP(pp_pushmark)
 {
     PUSHMARK(PL_stack_sp);
@@ -647,8 +648,8 @@ PP(pp_add)
                    if (aiv >= 0) {
                        auv = aiv;
                        auvok = 1;      /* Now acting as a sign flag.  */
-                   } else { /* 2s complement assumption for IV_MIN */
-                       auv = (UV)-aiv;
+                   } else {
+                       auv = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
                    }
                }
                a_valid = 1;
@@ -668,7 +669,7 @@ PP(pp_add)
                    buv = biv;
                    buvok = 1;
                } else
-                   buv = (UV)-biv;
+                    buv = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
            }
            /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
               else "IV" now, independent of how it came in.
@@ -709,7 +710,8 @@ PP(pp_add)
                else {
                    /* Negate result */
                    if (result <= (UV)IV_MIN)
-                       SETi( -(IV)result );
+                        SETi(result == (UV)IV_MIN
+                                ? IV_MIN : -(IV)result);
                    else {
                        /* result valid, but out of range for IV.  */
                        SETn( -(NV)result );
@@ -1553,7 +1555,7 @@ PP(pp_match)
     }
     NOT_REACHED; /* NOTREACHED */
 
-nope:
+  nope:
     if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) {
         if (!mg)
             mg = mg_find_mglob(TARG);
@@ -1631,8 +1633,7 @@ Perl_do_readline(pTHX)
        if (gimme == G_SCALAR) {
            /* undef TARG, and push that undefined value */
            if (type != OP_RCATLINE) {
-               SV_CHECK_THINKFIRST_COW_DROP(TARG);
-               SvOK_off(TARG);
+               sv_setsv(TARG,NULL);
            }
            PUSHTARG;
        }
@@ -1876,14 +1877,14 @@ S_softref2xv_lite(pTHX_ SV *const sv, const char *const what,
 }
 
 
-/* handle one or more derefs and array/hash indexings, e.g.
- * $h->{foo} or $a[0]{$key}[$i] or f()->[1]
+/* Handle one or more aggregate derefs and array/hash indexings, e.g.
+ * $h->{foo}  or  $a[0]{$key}[$i]  or  f()->[1]
  *
  * op_aux points to an array of unions of UV / IV / SV* / PADOFFSET.
- * Each of these either contains an action, or an argument, such as
- * a UV to use as an array index, or a lexical var to retrieve.
- * In fact, several actions re stored per UV; we keep shifting new actions
- * of the one UV, and only reload when it becomes zero.
+ * Each of these either contains a set of actions, or an argument, such as
+ * an IV to use as an array index, or a lexical var to retrieve.
+ * Several actions re stored per UV; we keep shifting new actions off the
+ * one UV, and only reload when it becomes zero.
  */
 
 PP(pp_multideref)
@@ -2946,8 +2947,12 @@ PP(pp_leavesub)
     PERL_CONTEXT *cx;
     SV *sv;
 
-    if (CxMULTICALL(&cxstack[cxstack_ix]))
+    if (CxMULTICALL(&cxstack[cxstack_ix])) {
+        /* entry zero of a stack is always PL_sv_undef, which
+         * simplifies converting a '()' return into undef in scalar context */
+        assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
        return 0;
+    }
 
     POPBLOCK(cx,newpm);
     cxstack_ix++; /* temporarily protect top context */
@@ -3095,7 +3100,7 @@ PP(pp_entersub)
        }
        /* should call AUTOLOAD now? */
        else {
-try_autoload:
+          try_autoload:
            if ((autogv = gv_autoload_pvn(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
                                   GvNAMEUTF8(gv) ? SVf_UTF8 : 0)))
            {
@@ -3610,11 +3615,5 @@ PP(pp_method_redir_super)
 }
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
  * ex: set ts=8 sts=4 sw=4 et:
  */