NV nr = SvNVX(svr);
NV result;
- if (
-#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
- !Perl_isnan(nl) && nl == (NV)(il = (IV)nl)
- && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr)
-#else
- nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr)
-#endif
- )
+ if (lossless_NV_to_IV(nl, &il) && lossless_NV_to_IV(nr, &ir)) {
/* nothing was lost by converting to IVs */
goto do_iv;
+ }
SP--;
result = nl * nr;
# if defined(__sgi) && defined(USE_LONG_DOUBLE) && LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE && NVSIZE == 16
alow = aiv;
auvok = TRUE; /* effectively it's a UV now */
} else {
- /* abs, auvok == false records sign */
- alow = -(UV)aiv;
+ /* abs, auvok == false records sign; Using 0- here and
+ * later to silence bogus warning from MS VC */
+ alow = (UV) (0 - (UV) aiv);
}
}
if (buvok) {
buvok = TRUE; /* effectively it's a UV now */
} else {
/* abs, buvok == false records sign */
- blow = -(UV)biv;
+ blow = (UV) (0 - (UV) biv);
}
}
right = biv;
right_neg = FALSE; /* effectively it's a UV now */
} else {
- right = -(UV)biv;
+ right = (UV) (0 - (UV) biv);
}
}
}
left = aiv;
left_neg = FALSE; /* effectively it's a UV now */
} else {
- left = -(UV)aiv;
+ left = (UV) (0 - (UV) aiv);
}
}
}
else {
dTOPss;
ASSUME(MARK + 1 == SP);
- XPUSHs(sv);
+ MEXTEND(SP, 1);
+ PUSHs(sv);
MARK[1] = &PL_sv_undef;
}
SP = MARK + 2;
NV nl = SvNVX(svl);
NV nr = SvNVX(svr);
- if (
-#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
- !Perl_isnan(nl) && nl == (NV)(il = (IV)nl)
- && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr)
-#else
- nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr)
-#endif
- )
+ if (lossless_NV_to_IV(nl, &il) && lossless_NV_to_IV(nr, &ir)) {
/* nothing was lost by converting to IVs */
goto do_iv;
+ }
SP--;
TARGn(nl - nr, 0); /* args not GMG, so can't be tainted */
SETs(TARG);
auv = aiv;
auvok = 1; /* Now acting as a sign flag. */
} else {
- auv = -(UV)aiv;
+ auv = (UV) (0 - (UV) aiv);
}
}
a_valid = 1;
buv = biv;
buvok = 1;
} else
- buv = -(UV)biv;
+ buv = (UV) (0 - (UV) biv);
}
/* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
else "IV" now, independent of how it came in.
shift = -shift;
left = !left;
}
- if (shift >= IV_BITS) {
+ if (UNLIKELY(shift >= IV_BITS)) {
return 0;
}
return left ? uv << shift : uv >> shift;
static IV S_iv_shift(IV iv, int shift, bool left)
{
- if (shift < 0) {
- shift = -shift;
- left = !left;
- }
- if (shift >= IV_BITS) {
- return iv < 0 && !left ? -1 : 0;
- }
- return left ? iv << shift : iv >> shift;
+ if (shift < 0) {
+ shift = -shift;
+ left = !left;
+ }
+
+ if (UNLIKELY(shift >= IV_BITS)) {
+ return iv < 0 && !left ? -1 : 0;
+ }
+
+ /* For left shifts, perl 5 has chosen to treat the value as unsigned for
+ * the * purposes of shifting, then cast back to signed. This is very
+ * different from perl 6:
+ *
+ * $ perl6 -e 'say -2 +< 5'
+ * -64
+ *
+ * $ ./perl -le 'print -2 << 5'
+ * 18446744073709551552
+ * */
+ if (left) {
+ if (iv == IV_MIN) { /* Casting this to a UV is undefined behavior */
+ return 0;
+ }
+ return (IV) (((UV) iv) << shift);
+ }
+
+ /* Here is right shift */
+ return iv >> shift;
}
#define UV_LEFT_SHIFT(uv, shift) S_uv_shift(uv, shift, TRUE)
if (len && ! utf8_to_bytes(tmps, &len)) {
Perl_croak(aTHX_ FATAL_ABOVE_FF_MSG, PL_op_desc[PL_op->op_type]);
}
- SvCUR(TARG) = len;
+ SvCUR_set(TARG, len);
SvUTF8_off(TARG);
}
anum = len;
-#ifdef LIBERAL
{
long *tmpl;
- for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
+ for ( ; anum && PTR2nat(tmps) % sizeof(long); anum--, tmps++)
*tmps = ~*tmps;
tmpl = (long*)tmps;
for ( ; anum >= (I32)sizeof(long); anum -= (I32)sizeof(long), tmpl++)
*tmpl = ~*tmpl;
tmps = (U8*)tmpl;
}
-#endif
+
for ( ; anum > 0; anum--, tmps++)
*tmps = ~*tmps;
}
else if (DO_UTF8(source)) { /* Is the source utf8? */
doing_utf8 = TRUE;
ulen = UTF8SKIP(s);
+
if (op_type == OP_UCFIRST) {
#ifdef USE_LOCALE_CTYPE
_toTITLE_utf8_flags(s, s +slen, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
/* In a "use bytes" we don't treat the source as UTF-8, but, still want
* the destination to retain that flag */
- if (SvUTF8(source) && ! IN_BYTES)
+ if (DO_UTF8(source))
SvUTF8_on(dest);
if (!inplace) { /* Finish the rest of the string, unchanged */
PP(pp_uc)
{
+ dVAR;
dSP;
SV *source = TOPs;
STRLEN len;
SvCUR_set(dest, len);
len = sv_utf8_upgrade_flags_grow(dest,
SV_GMAGIC|SV_FORCE_UTF8_UPGRADE,
- extra);
+ extra
+ + 1 /* trailing NUL */ );
d = (U8*)SvPVX(dest) + len;
/* Now process the remainder of the source, simultaneously
* when converted to UTF-8 */
sv_utf8_upgrade_flags_grow(dest, 0, len
+ I_count
- + variant_under_utf8_count(s, send));
+ + variant_under_utf8_count(s, send)
+ + 1 /* Trailing NUL */ );
d = (U8*)SvPVX(dest);
has_turkic_I = TRUE;
}
SvCUR_set(dest, len);
len = sv_utf8_upgrade_flags_grow(dest,
SV_GMAGIC|SV_FORCE_UTF8_UPGRADE,
- extra);
+ extra
+ + 1 /* Trailing NUL */ );
d = (U8*)SvPVX(dest) + len;
*d++ = UTF8_TWO_BYTE_HI(GREEK_SMALL_LETTER_MU);
/* The rx->minlen is in characters but we want to step
* s ahead by bytes. */
if (do_utf8)
- s = (char*)utf8_hop((U8*)m, len);
+ s = (char*)utf8_hop_forward((U8*) m, len, (U8*) strend);
else
s = m + len; /* Fake \n at the end */
}
/* The rx->minlen is in characters but we want to step
* s ahead by bytes. */
if (do_utf8)
- s = (char*)utf8_hop((U8*)m, len);
+ s = (char*)utf8_hop_forward((U8*)m, len, (U8 *) strend);
else
s = m + len; /* Fake \n at the end */
}
return sv;
}
-/* Check a a subs arguments - i.e. that it has the correct number of args
+/* Check a sub's arguments - i.e. that it has the correct number of args
* (and anything else we might think of in future). Typically used with
* signatured subs.
*/
PP(pp_argcheck)
{
OP * const o = PL_op;
- UNOP_AUX_item *aux = cUNOP_AUXo->op_aux;
- IV params = aux[0].iv;
- IV opt_params = aux[1].iv;
- char slurpy = (char)(aux[2].iv);
+ struct op_argcheck_aux *aux = (struct op_argcheck_aux *)cUNOP_AUXo->op_aux;
+ UV params = aux->params;
+ UV opt_params = aux->opt_params;
+ char slurpy = aux->slurpy;
AV *defav = GvAV(PL_defgv); /* @_ */
- IV argc;
+ UV argc;
bool too_few;
assert(!SvMAGICAL(defav));
- argc = (AvFILLp(defav) + 1);
+ argc = (UV)(AvFILLp(defav) + 1);
too_few = (argc < (params - opt_params));
if (UNLIKELY(too_few || (!slurpy && argc > params)))
https://perl5.git.perl.org / perl5.git / blobdiff