In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/a5ba819fc61657341addc515e13a09c715b9597d?hp=75763b3aeee4912655f280922a10857e88d74104>

- Log -----------------------------------------------------------------
commit a5ba819fc61657341addc515e13a09c715b9597d
Author: David Mitchell <[email protected]>
Date:   Mon Dec 22 21:36:14 2014 +0000

    Configure: silence ASan warnings
    
    When run under -fsanitize=undefined, some of the try.c's that are compiled
    and executed give runtime warnings. Since the intent of these particular
    executables is to probe beyond certain limits in order to determine those
    limits, these warnings can be safely ignored.  So file them in /dev/null.

M       Configure

commit a08678bcb2357aeaaca8647b1fbfb92d260c22e6
Author: David Mitchell <[email protected]>
Date:   Wed Dec 31 11:16:06 2014 +0000

    File::Glob: avoid qsort() on no entries
    
    If a glob doesn't match anything, it will try to call qsort()
    with a null pointer, and on my OS, qsort() marked as needing a non-null
    arg, which clang 3.6 is now detecting.

M       ext/File-Glob/bsd_glob.c

commit 370e91aa758ff850f955a2c2502e9d48ec70390f
Author: David Mitchell <[email protected]>
Date:   Tue Dec 23 19:32:43 2014 +0000

    clone PL_cv_has_eval and PL_savebegin
    
    These two boolean vars weren't being cloned in new threads, and in
    debugging builds were getting set to 0xab, which -fsanitize=undefined
    regarded as no suitable value for a boolean.

M       sv.c

commit 4611430f16852b05a29ad1bbac94eb33e89c957d
Author: David Mitchell <[email protected]>
Date:   Tue Dec 23 10:38:01 2014 +0000

    sv_vcatpvfn_flags() avoid array bounds err
    
    clang -fsanitize=undefined is being a bit too clever for its own good
    here.
    
    The code looks something like
    
        U8 vhex[VHEX_SIZE];
        ...
        v = vhex + ...;
        if (v < vend) ...
    
    The code itself is safe, but ASan detects if you've added a value
    greater than the buffer size to vhex and whines.
    
    I've changed it so that the conditional comes first and is done in such
    a way that arbitrary values can't be added to vhex.
    
    To reproduce:
    
        printf "%.1000a\n", 1;
    
    gives
    
        sv.c:12327:34: runtime error: index 1000 out of bounds for type 'U8 
[17]'

M       sv.c

commit 0213d723ad5ab5e1e73d506449510c725bbdd15d
Author: David Mitchell <[email protected]>
Date:   Mon Dec 22 20:57:52 2014 +0000

    asan_ignore: exclude S_expect_number()
    
    This function numifies the field width string in something like
    printf "%10f". It handles integer overflow itself, so suppress
    ASan warnings, e.g.
    
    sv.c:10716:26: runtime error: signed integer overflow: 922337203 * 10 
cannot be represented in type 'int'

M       asan_ignore

commit ea11461288d14099c29bf480cfd98479d3613a9c
Author: David Mitchell <[email protected]>
Date:   Mon Dec 22 20:23:28 2014 +0000

    fix integer overflow in S_study_chunk().
    
    Don't increment delta if it's "infinity" (SSize_t_MAX)
    Found by -fsanitize=undefined:
    
    regcomp.c:4999:11: runtime error: signed integer overflow: 
9223372036854775807 + 1 cannot be represented in type 'ssize_t' (aka 'long')

M       regcomp.c

commit e68aed92f594456b596d9b3d8c0fba00406fe76d
Author: David Mitchell <[email protected]>
Date:   Mon Dec 22 20:12:22 2014 +0000

    pack(): avoid << of negative values
    
    Treat the string as U8* rather than char* when doing all the
    bit shifts for uuencode. That stops these warnings under ASan:
    
        pp_pack.c:1890:34: runtime error: left shift of negative value -127
        pp_pack.c:1891:34: runtime error: left shift of negative value -126
        pp_pack.c:1899:34: runtime error: left shift of negative value -1
        pp_pack.c:1900:30: runtime error: left shift of negative value -31

M       pp_pack.c

commit fc01cab408a7f4e5d9726611998d5b9c01f727ae
Author: David Mitchell <[email protected]>
Date:   Mon Dec 22 20:04:59 2014 +0000

    avoid integer overflow in pp_flop()
    
    This;
        @a=(0x7ffffffffffffffe..0x7fffffffffffffff);
    
    could produce under ASan:
    
        pp_ctl.c:1212:19: runtime error: signed integer overflow: 
9223372036854775807 + 1 cannot be represented in type 'IV' (aka 'long')
    
    so avoid post-incrementing the loop var on the last iteration.
    
    This fix is more to shut ASan up than an actual bug, since the
    bad value on the last iteration wouldn't actually be used.

M       pp_ctl.c

commit 02b08bbcbd0ac87188306a567fc071bbfd134777
Author: David Mitchell <[email protected]>
Date:   Mon Dec 22 16:25:59 2014 +0000

    fix more -IV_MIN negations
    
    Doing uv = -iv is undefined behaviour if iv happens to be IV_MIN.
    This occurs in several places in the perl sources.
    
    These ones were found by visual code inspection rather than
    using -fsanitize=undefined, but I've added extra tests so that
    -fsanitize could find them now.

M       pp.c
M       sv.c
M       t/op/64bitint.t
M       t/opbasic/arith.t

commit 919894b775f42c5afd2195b1a5240e66205560d1
Author: David Mitchell <[email protected]>
Date:   Mon Dec 22 09:34:40 2014 +0000

    fix undefined float behaviour in pack('f')
    
    The C standard says that the value of the expression (float)double_var is
    undefined if 'the value being converted is outside the range of values
    that can be represented'.
    
    So to shut up -fsanitize=undefined:
    
        my $p = pack 'f', 1.36514538e67;
    
    giving
    
        runtime error: value 1.36515e+67 is outside the range of representable 
values of type 'float'
    
    explicitly handle the out of range values.
    Something similar is already done under defined(VMS) && !defined(_IEEE_FP),
    except that there it floors to +/- FLT_MAX rather than +/- (float)NV_INF.
    I don't know which branch is best, and whether they should be merged.
    
    This fix was suggested by Aaron Crane.

M       pp_pack.c

commit 2afa5dd07629c20c6931b8c5e4c1671520787a9d
Author: David Mitchell <[email protected]>
Date:   Sun Dec 21 00:40:13 2014 +0000

    avoid integer overflow in Perl_av_extend_guts()
    
    There were two issues; first the 'overextend' algorithm (add a fifth of
    the current size to the requested size) could overflow,
    and secondly MEM_WRAP_CHECK_1() was being called with newmax+1,
    which could overflow if newmax happened to equal SSize_t_MAX.
    
    e.g.
    
        $a[0x7fffffffffffffff] = 1
        $a[5] = 1; $a[0x7fffffffffffffff] = 1
    
    could produce under ASan:
    
        av.c:133:16: runtime error: signed integer overflow: 
9223372036854775807 + 1 cannot be represented in type 'long'
        av.c:170:7: runtime error: signed integer overflow: 9223372036854775807 
+ 1 cannot be represented in type 'long'

M       av.c

commit cbb52ffe38ad57101631b748bc04127568f728e2
Author: David Mitchell <[email protected]>
Date:   Sun Dec 21 00:00:10 2014 +0000

    asan_ignore: exclude Perl_pp_left_shift()
    
    << in perl maps directly to << in C, so don't warn about it when the RHS
    is too big.
    
    Fixes e.g.:
    
        print 1 << 64
        use integer; print 1 << 63
    
    Typical ASan warning:
    
    pp.c:1893:2: runtime error: left shift of 1 by 63 places cannot be 
represented in type 'IV' (aka 'long')

M       asan_ignore

commit 53e2bfb7c6a2e8a3171dabe7dbdc24eba77e4bf0
Author: David Mitchell <[email protected]>
Date:   Sat Dec 20 16:40:52 2014 +0000

    fix -IV_MIN negations
    
    Doing uv = -iv is undefined behaviour if iv happens to be IV_MIN.
    This occurs in several places in the perl sources.
    
    Found by -fsanitize=undefined.
    
    Here's a typical message:
    
    sv.c:2864:7: runtime error: negation of -9223372036854775808 cannot be 
represented in type 'IV' (aka 'long'); cast to an unsigned type to negate this 
value to itself

M       pp.c
M       pp_hot.c
M       sv.c

commit 382a7a77501a1e25895d78eca9cb6838c6d7e6a3
Author: David Mitchell <[email protected]>
Date:   Sat Dec 20 15:30:01 2014 +0000

    fix integer overflow in S_study_chunk().
    
    It was calculating final_minlen + delta even when delta was already
    SSize_t_MAX and final_minlen > 0.
    
    This triggered it: /a(??{}){2}/.
    
    Found by -fsanitize=undefined:
    
    regcomp.c:5623:89: runtime error: signed integer overflow: 1 + 
9223372036854775807 cannot be represented in type 'long'

M       regcomp.c
-----------------------------------------------------------------------

Summary of changes:
 Configure                | 10 +++++-----
 asan_ignore              | 11 +++++++++++
 av.c                     | 16 +++++++++++++---
 ext/File-Glob/bsd_glob.c |  1 +
 pp.c                     | 30 +++++++++++++++++++-----------
 pp_ctl.c                 |  4 +++-
 pp_hot.c                 |  9 +++++----
 pp_pack.c                | 13 ++++++++-----
 regcomp.c                | 10 +++++++---
 sv.c                     | 25 ++++++++++++++++++-------
 t/op/64bitint.t          |  9 +++++++++
 t/opbasic/arith.t        | 10 +++++++++-
 12 files changed, 108 insertions(+), 40 deletions(-)

diff --git a/Configure b/Configure
index 7f91d7d..a8d8b5a 100755
--- a/Configure
+++ b/Configure
@@ -11599,7 +11599,7 @@ int main()
 EOCP
 set try
 if eval $compile_ok; then
-       $run ./try
+       $run ./try 2>/dev/null
        yyy=$?
 else
        echo "(I can't seem to compile the test program--assuming it can't)"
@@ -11699,7 +11699,7 @@ int main()
 EOCP
 set try
 if eval $compile_ok; then
-       $run ./try
+       $run ./try 2>/dev/null
        castflags=$?
 else
        echo "(I can't seem to compile the test program--assuming it can't)"
@@ -21453,7 +21453,7 @@ int main (int argc, char *argv[])
 EOCP
        set try
        if eval $compile; then
-           eval `$run ./try`
+           eval `$run ./try 2>/dev/null`
        else
            echo "Cannot determine sGMTIME_max and sGMTIME_min." >&4
            fi
@@ -21534,7 +21534,7 @@ int main (int argc, char *argv[])
 EOCP
        set try
        if eval $compile; then
-           eval `$run ./try`
+           eval `$run ./try 2>/dev/null`
        else
            echo "Cannot determine sLOCALTIME_max and sLOCALTIME_min." >&4
            fi
@@ -21666,7 +21666,7 @@ int main() {
 EOCP
                set try
                if eval $compile_ok; then
-                       selectminbits=`$run ./try`
+                       selectminbits=`$run ./try 2>/dev/null`
                        case "$selectminbits" in
                        '')     cat >&4 <<EOM
 Cannot figure out on how many bits at a time your select() operates.
diff --git a/asan_ignore b/asan_ignore
index 5a8bc5c..e0f5685 100644
--- a/asan_ignore
+++ b/asan_ignore
@@ -17,3 +17,14 @@
 # nor =signed-integer-overflow worked.
 
 fun:Perl_pp_i_*
+
+# Perl's << is defined as using the underlying C's << operator, with the
+# same undefined behaviour for shifts greater than the word size.
+# (UVs normally, IVs with 'use integer')
+
+fun:Perl_pp_left_shift
+
+# this function numifies the field width in eg printf "%10f".
+# It has its own overflow detection, so don't warn about it
+
+fun:S_expect_number
diff --git a/av.c b/av.c
index 3de7b83..53690d5 100644
--- a/av.c
+++ b/av.c
@@ -130,14 +130,23 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t 
*maxp, SV ***allocp,
                if (key <= newmax) 
                    goto resized;
 #endif 
-               newmax = key + *maxp / 5;
+                /* overflow-safe version of newmax = key + *maxp/5 */
+               newmax = *maxp / 5;
+                newmax = (key > SSize_t_MAX - newmax)
+                            ? SSize_t_MAX : key + newmax;
              resize:
                {
 #ifdef PERL_MALLOC_WRAP /* Duplicated in pp_hot.c */
                    static const char oom_array_extend[] =
                        "Out of memory during array extend";
 #endif
-                   MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
+                    /* it should really be newmax+1 here, but if newmax
+                     * happens to equal SSize_t_MAX, then newmax+1 is
+                     * undefined. This means technically we croak one
+                     * index lower than we should in theory; in practice
+                     * its unlikely the system has SSize_t_MAX/sizeof(SV*)
+                     * bytes to spare! */
+                   MEM_WRAP_CHECK_1(newmax, SV*, oom_array_extend);
                }
 #ifdef STRESS_REALLOC
                {
@@ -167,7 +176,8 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t 
*maxp, SV ***allocp,
                    static const char oom_array_extend[] =
                        "Out of memory during array extend";
 #endif
-                   MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
+                    /* see comment above about newmax+1*/
+                   MEM_WRAP_CHECK_1(newmax, SV*, oom_array_extend);
                }
                Newx(*allocp, newmax+1, SV*);
                ary = *allocp + 1;
diff --git a/ext/File-Glob/bsd_glob.c b/ext/File-Glob/bsd_glob.c
index 2ba0d49..821ef20 100644
--- a/ext/File-Glob/bsd_glob.c
+++ b/ext/File-Glob/bsd_glob.c
@@ -602,6 +602,7 @@ glob0(const Char *pattern, glob_t *pglob)
                return(globextend(qpat, pglob, &limit));
         }
        else if (!(pglob->gl_flags & GLOB_NOSORT))
+            if (pglob->gl_pathv)
                qsort(pglob->gl_pathv + pglob->gl_offs + oldpathc,
                    pglob->gl_pathc - oldpathc, sizeof(char *),
                    (pglob->gl_flags & (GLOB_ALPHASORT|GLOB_NOCASE))
diff --git a/pp.c b/pp.c
index 08e0999..4f43704 100644
--- a/pp.c
+++ b/pp.c
@@ -1298,7 +1298,8 @@ PP(pp_multiply)
                    alow = aiv;
                    auvok = TRUE; /* effectively it's a UV now */
                } else {
-                   alow = -aiv; /* abs, auvok == false records sign */
+                    /* abs, auvok == false records sign */
+                   alow = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
                }
            }
            if (buvok) {
@@ -1309,7 +1310,8 @@ PP(pp_multiply)
                    blow = biv;
                    buvok = TRUE; /* effectively it's a UV now */
                } else {
-                   blow = -biv; /* abs, buvok == false records sign */
+                    /* abs, buvok == false records sign */
+                   blow = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
                }
            }
 
@@ -1335,6 +1337,10 @@ PP(pp_multiply)
                    /* 2s complement assumption that (UV)-IV_MIN is correct.  */
                    /* -ve result, which could overflow an IV  */
                    SP--;
+                    /* can't negate IV_MIN, but there are aren't two
+                     * integers such that !ahigh && !bhigh, where the
+                     * product equals 0x800....000 */
+                    assert(product != (UV)IV_MIN);
                    SETi( -(IV)product );
                    RETURN;
                } /* else drop to NVs below. */
@@ -1372,7 +1378,8 @@ PP(pp_multiply)
                            /* 2s complement assumption again  */
                            /* -ve result, which could overflow an IV  */
                            SP--;
-                           SETi( -(IV)product_low );
+                           SETi(product_low == (UV)IV_MIN
+                                    ? IV_MIN : -(IV)product_low);
                            RETURN;
                        } /* else drop to NVs below. */
                    }
@@ -1434,7 +1441,7 @@ PP(pp_divide)
                     right_non_neg = TRUE; /* effectively it's a UV now */
                 }
                else {
-                    right = -biv;
+                    right = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
                 }
             }
             /* historically undef()/0 gives a "Use of uninitialized value"
@@ -1455,7 +1462,7 @@ PP(pp_divide)
                     left_non_neg = TRUE; /* effectively it's a UV now */
                 }
                else {
-                    left = -aiv;
+                    left = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
                 }
             }
 
@@ -1485,7 +1492,7 @@ PP(pp_divide)
                     }
                     /* 2s complement assumption */
                     if (result <= (UV)IV_MIN)
-                        SETi( -(IV)result );
+                        SETi(result == (UV)IV_MIN ? IV_MIN : -(IV)result);
                     else {
                         /* It's exact but too negative for IV. */
                         SETn( -(NV)result );
@@ -1535,7 +1542,7 @@ PP(pp_modulo)
                     right = biv;
                     right_neg = FALSE; /* effectively it's a UV now */
                 } else {
-                    right = -biv;
+                    right = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
                 }
             }
         }
@@ -1565,7 +1572,7 @@ PP(pp_modulo)
                         left = aiv;
                         left_neg = FALSE; /* effectively it's a UV now */
                     } else {
-                        left = -aiv;
+                        left = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
                     }
                 }
         }
@@ -1797,7 +1804,7 @@ PP(pp_subtract)
                        auv = aiv;
                        auvok = 1;      /* Now acting as a sign flag.  */
                    } else { /* 2s complement assumption for IV_MIN */
-                       auv = (UV)-aiv;
+                       auv = (aiv == IV_MIN) ? (UV)aiv : (UV)-aiv;
                    }
                }
                a_valid = 1;
@@ -1817,7 +1824,7 @@ PP(pp_subtract)
                    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.
@@ -1858,7 +1865,8 @@ PP(pp_subtract)
                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 );
diff --git a/pp_ctl.c b/pp_ctl.c
index c3acd46..f2c9856 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1209,8 +1209,10 @@ PP(pp_flop)
            else
                n = 0;
            while (n--) {
-               SV * const sv = sv_2mortal(newSViv(i++));
+               SV * const sv = sv_2mortal(newSViv(i));
                PUSHs(sv);
+                if (n) /* avoid incrementing above IV_MAX */
+                    i++;
            }
        }
        else {
diff --git a/pp_hot.c b/pp_hot.c
index 3ee4818..4072ab1 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -647,8 +647,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 +668,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 +709,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 );
diff --git a/pp_pack.c b/pp_pack.c
index ad4f186..60462eb 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -1882,7 +1882,7 @@ PP(pp_unpack)
 }
 
 STATIC U8 *
-doencodes(U8 *h, const char *s, I32 len)
+doencodes(U8 *h, const U8 *s, I32 len)
 {
     *h++ = PL_uuemap[len];
     while (len > 2) {
@@ -1894,7 +1894,7 @@ doencodes(U8 *h, const char *s, I32 len)
        len -= 3;
     }
     if (len > 0) {
-        const char r = (len > 1 ? s[1] : '\0');
+        const U8 r = (len > 1 ? s[1] : '\0');
        *h++ = PL_uuemap[(077 & (s[0] >> 2))];
        *h++ = PL_uuemap[(077 & (((s[0] << 4) & 060) | ((r >> 4) & 017)))];
        *h++ = PL_uuemap[(077 & ((r << 2) & 074))];
@@ -2719,7 +2719,10 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV 
**beglist, SV **endlist )
                    afloat = -FLT_MAX;
                else afloat = (float)anv;
 # else
-               afloat = (float)anv;
+                /* a simple cast to float is undefined if outside
+                 * the range of values that can be represented */
+               afloat = (float)(anv >  FLT_MAX ?  NV_INF :
+                                 anv < -FLT_MAX ? -NV_INF : anv);
 # endif
                 PUSH_VAR(utf8, cur, afloat, needs_swap);
            }
@@ -3107,9 +3110,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV 
**beglist, SV **endlist )
                                   "aptr=%p, aend=%p, buffer=%p, todo=%ld",
                                   aptr, aend, buffer, (long) todo);
                    }
-                   end = doencodes(hunk, buffer, todo);
+                   end = doencodes(hunk, (const U8 *)buffer, todo);
                } else {
-                   end = doencodes(hunk, aptr, todo);
+                   end = doencodes(hunk, (const U8 *)aptr, todo);
                    aptr += todo;
                }
                PUSH_BYTES(utf8, cur, hunk, end-hunk, 0);
diff --git a/regcomp.c b/regcomp.c
index c2521a9..b11047f 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -5022,7 +5022,8 @@ PerlIO_printf(Perl_debug_log, "LHS=%"UVuf" RHS=%"UVuf"\n",
                flags &= ~SCF_DO_STCLASS;
             }
            min++;
-           delta++;    /* Because of the 2 char string cr-lf */
+            if (delta != SSize_t_MAX)
+                delta++;    /* Because of the 2 char string cr-lf */
             if (flags & SCF_DO_SUBSTR) {
                 /* Cannot expect anything... */
                 scan_commit(pRExC_state, data, minlenp, is_inf);
@@ -5647,8 +5648,11 @@ PerlIO_printf(Perl_debug_log, "LHS=%"UVuf" 
RHS=%"UVuf"\n",
     {
         SSize_t final_minlen= min < stopmin ? min : stopmin;
 
-        if (!(RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN) && (RExC_maxlen < 
final_minlen + delta)) {
-            RExC_maxlen = final_minlen + delta;
+        if (!(RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN)) {
+            if (final_minlen > SSize_t_MAX - delta)
+                RExC_maxlen = SSize_t_MAX;
+            else if (RExC_maxlen < final_minlen + delta)
+                RExC_maxlen = final_minlen + delta;
         }
         return final_minlen;
     }
diff --git a/sv.c b/sv.c
index 94740d3..fe092c4 100644
--- a/sv.c
+++ b/sv.c
@@ -2158,6 +2158,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv)
            SvIV_set(sv, I_V(SvNVX(sv)));
            if (SvNVX(sv) == (NV) SvIVX(sv)
 #ifndef NV_PRESERVES_UV
+                && SvIVX(sv) != IV_MIN /* avoid negating IV_MIN below */
                && (((UV)1 << NV_PRESERVES_UV_BITS) >
                    (UV)(SvIVX(sv) > 0 ? SvIVX(sv) : -SvIVX(sv)))
                /* Don't flag it as "accurately an integer" if the number
@@ -2273,7 +2274,8 @@ S_sv_2iuv_common(pTHX_ SV *const sv)
            } else {
                /* 2s complement assumption  */
                if (value <= (UV)IV_MIN) {
-                   SvIV_set(sv, -(IV)value);
+                   SvIV_set(sv, value == (UV)IV_MIN
+                                    ? IV_MIN : -(IV)value);
                } else {
                    /* Too negative for an IV.  This is a double upgrade, but
                       I'm assuming it will be rare.  */
@@ -2732,7 +2734,7 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
             SvNOK_on(sv);
         } else {
             /* value has been set.  It may not be precise.  */
-           if ((numtype & IS_NUMBER_NEG) && (value > (UV)IV_MIN)) {
+           if ((numtype & IS_NUMBER_NEG) && (value >= (UV)IV_MIN)) {
                /* 2s complement assumption for (UV)IV_MIN  */
                 SvNOK_on(sv); /* Integer is too negative.  */
             } else {
@@ -2740,6 +2742,10 @@ Perl_sv_2nv_flags(pTHX_ SV *const sv, const I32 flags)
                 SvIOKp_on(sv);
 
                 if (numtype & IS_NUMBER_NEG) {
+                    /* -IV_MIN is undefined, but we should never reach
+                     * this point with both IS_NUMBER_NEG and value ==
+                     * (UV)IV_MIN */
+                    assert(value != (UV)IV_MIN);
                     SvIV_set(sv, -(IV)value);
                 } else if (value <= (UV)IV_MAX) {
                    SvIV_set(sv, (IV)value);
@@ -2861,7 +2867,7 @@ S_uiv_2buf(char *const buf, const IV iv, UV uv, const int 
is_uv, char **const pe
        uv = iv;
        sign = 0;
     } else {
-       uv = -iv;
+        uv = (iv == IV_MIN) ? (UV)iv : (UV)(-iv);
        sign = 1;
     }
     do {
@@ -11898,7 +11904,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char 
*const pat, const STRLEN p
                        esignbuf[esignlen++] = plus;
                }
                else {
-                   uv = -iv;
+                   uv = (iv == IV_MIN) ? (UV)iv : (UV)(-iv);
                    esignbuf[esignlen++] = '-';
                }
            }
@@ -12358,12 +12364,14 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char 
*const pat, const STRLEN p
 #endif
 
                     if (precis > 0) {
-                        v = vhex + precis + 1;
-                        if (v < vend) {
+                        if ((SSize_t)(precis + 1) < vend - vhex) {
+                            bool round;
+
+                            v = vhex + precis + 1;
                             /* Round away from zero: if the tail
                              * beyond the precis xdigits is equal to
                              * or greater than 0x8000... */
-                            bool round = *v > 0x8;
+                            round = *v > 0x8;
                             if (!round && *v == 0x8) {
                                 for (v++; v < vend; v++) {
                                     if (*v) {
@@ -14566,6 +14574,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_subline         = proto_perl->Isubline;
 
+    PL_cv_has_eval     = proto_perl->Icv_has_eval;
+
 #ifdef FCRYPT
     PL_cryptseen       = proto_perl->Icryptseen;
 #endif
@@ -14824,6 +14834,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_endav           = av_dup_inc(proto_perl->Iendav, param);
     PL_checkav         = av_dup_inc(proto_perl->Icheckav, param);
     PL_initav          = av_dup_inc(proto_perl->Iinitav, param);
+    PL_savebegin       = proto_perl->Isavebegin;
 
     PL_isarev          = hv_dup_inc(proto_perl->Iisarev, param);
 
diff --git a/t/op/64bitint.t b/t/op/64bitint.t
index 168d597..fcf9949 100644
--- a/t/op/64bitint.t
+++ b/t/op/64bitint.t
@@ -355,4 +355,13 @@ cmp_ok($q, '==', -9223372036854775806);
     unlike($q, qr/[e.]/, 'Should not be floating point');
 }
 
+# trigger various attempts to negate IV_MIN
+
+cmp_ok  0x8000000000000000 / -0x8000000000000000, '==', -1, '(IV_MAX+1) / 
IV_MIN';
+cmp_ok -0x8000000000000000 /  0x8000000000000000, '==', -1, 'IV_MIN / 
(IV_MAX+1)';
+cmp_ok  0x8000000000000000 / -1, '==', -0x8000000000000000, '(IV_MAX+1) / -1';
+cmp_ok                   0 % -0x8000000000000000, '==',  0, '0 % IV_MIN';
+cmp_ok -0x8000000000000000 % -0x8000000000000000, '==',  0, 'IV_MIN % IV_MIN';
+
+
 done_testing();
diff --git a/t/opbasic/arith.t b/t/opbasic/arith.t
index 10efe86..3493968 100644
--- a/t/opbasic/arith.t
+++ b/t/opbasic/arith.t
@@ -9,7 +9,7 @@ BEGIN {
 # functions imported from t/test.pl or Test::More, as those programs/libraries
 # use operators which are what is being tested in this file.
 
-print "1..181\n";
+print "1..186\n";
 
 sub try ($$$) {
    print +($_[1] ? "ok" : "not ok"), " $_[0] - $_[2]\n";
@@ -476,3 +476,11 @@ try $T++, "1.23 "  + 0 ==  1.23,  '1.23 with trailing 
space';
 try $T++, "+1.23"  + 0 ==  1.23,  '1.23 with unary plus';
 try $T++, "-1.23"  + 0 == -1.23,  '1.23 with unary minus';
 try $T++, "1.23e4" + 0 ==  12300, '1.23e4';
+
+# trigger various attempts to negate IV_MIN
+
+tryeq $T++,  0x80000000 / -0x80000000, -1, '(IV_MAX+1) / IV_MIN';
+tryeq $T++, -0x80000000 /  0x80000000, -1, 'IV_MIN / (IV_MAX+1)';
+tryeq $T++,  0x80000000 / -1, -0x80000000, '(IV_MAX+1) / -1';
+tryeq $T++,           0 % -0x80000000,  0, '0 % IV_MIN';
+tryeq $T++, -0x80000000 % -0x80000000,  0, 'IV_MIN % IV_MIN';

--
Perl5 Master Repository

Reply via email to