#include "reentr.h"
#include "regcharclass.h"
-/* XXX I can't imagine anyone who doesn't have this actually _needs_
- it, since pid_t is an integral type.
- --AD 2/20/1998
-*/
-#ifdef NEED_GETPID_PROTO
-extern Pid_t getpid (void);
-#endif
-
static const STRLEN small_mu_len = sizeof(GREEK_SMALL_LETTER_MU_UTF8) - 1;
static const STRLEN capital_iota_len = sizeof(GREEK_CAPITAL_LETTER_IOTA_UTF8) - 1;
*/
if (vivify_sv && sv != &PL_sv_undef) {
GV *gv;
+ HV *stash;
if (SvREADONLY(sv))
Perl_croak_no_modify();
+ gv = MUTABLE_GV(newSV(0));
+ stash = CopSTASH(PL_curcop);
+ if (SvTYPE(stash) != SVt_PVHV) stash = NULL;
if (cUNOP->op_targ) {
SV * const namesv = PAD_SV(cUNOP->op_targ);
- HV *stash = CopSTASH(PL_curcop);
- if (SvTYPE(stash) != SVt_PVHV) stash = NULL;
- gv = MUTABLE_GV(newSV(0));
gv_init_sv(gv, stash, namesv, 0);
}
else {
- const char * const name = CopSTASHPV(PL_curcop);
- gv = newGVgen_flags(name,
- HvNAMEUTF8(CopSTASH(PL_curcop)) ? SVf_UTF8 : 0 );
- SvREFCNT_inc_simple_void_NN(gv);
+ gv_init_pv(gv, stash, "__ANONIO__", 0);
}
prepare_SV_for_RV(sv);
SvRV_set(sv, MUTABLE_SV(gv));
if (SvGMAGICAL(TOPs)) SETs(sv_mortalcopy(TOPs));
if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
const char * s = SvPVX_const(TOPs);
- if (strnEQ(s, "CORE::", 6)) {
+ if (memBEGINs(s, SvCUR(TOPs), "CORE::")) {
const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
if (!code)
DIE(aTHX_ "Can't find an opnumber for \"%" UTF8f "\"",
else if (SvPADTMP(sv)) {
sv = newSVsv(sv);
}
+ else if (UNLIKELY(SvSMAGICAL(sv) && mg_find(sv, PERL_MAGIC_nonelem)))
+ sv_unmagic(SvREFCNT_inc_simple_NN(sv), PERL_MAGIC_nonelem);
else {
SvTEMP_off(sv);
SvREFCNT_inc_void_NN(sv);
PUSHs(newsv);
}
else {
- I32 i = do_trans(sv);
- mPUSHi(i);
+ Size_t i = do_trans(sv);
+ mPUSHi((UV)i);
}
RETURN;
}
auvok = TRUE; /* effectively it's a UV now */
} else {
/* abs, auvok == false records sign */
- alow = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
+ alow = -(UV)aiv;
}
}
if (buvok) {
buvok = TRUE; /* effectively it's a UV now */
} else {
/* abs, buvok == false records sign */
- blow = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
+ blow = -(UV)biv;
}
}
can be too large to preserve, so don't need to compile the code to
test the size of UVs. */
-#ifdef SLOPPYDIVIDE
+#if defined(SLOPPYDIVIDE) || (defined(PERL_PRESERVE_IVUV) && !defined(NV_PRESERVES_UV))
# define PERL_TRY_UV_DIVIDE
/* ensure that 20./5. == 4. */
-#else
-# ifdef PERL_PRESERVE_IVUV
-# ifndef NV_PRESERVES_UV
-# define PERL_TRY_UV_DIVIDE
-# endif
-# endif
#endif
#ifdef PERL_TRY_UV_DIVIDE
right_non_neg = TRUE; /* effectively it's a UV now */
}
else {
- right = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
+ right = -(UV)biv;
}
}
/* historically undef()/0 gives a "Use of uninitialized value"
left_non_neg = TRUE; /* effectively it's a UV now */
}
else {
- left = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
+ left = -(UV)aiv;
}
}
#endif
) {
/* Integer division can't overflow, but it can be imprecise. */
+
+ /* Modern compilers optimize division followed by
+ * modulo into a single div instruction */
const UV result = left / right;
- if (result * right == left) {
+ if (left % right == 0) {
SP--; /* result is valid */
if (left_non_neg == right_non_neg) {
/* signs identical, result is positive. */
right = biv;
right_neg = FALSE; /* effectively it's a UV now */
} else {
- right = (biv == IV_MIN) ? (UV)biv : (UV)(-biv);
+ right = -(UV)biv;
}
}
}
left = aiv;
left_neg = FALSE; /* effectively it's a UV now */
} else {
- left = (aiv == IV_MIN) ? (UV)aiv : (UV)(-aiv);
+ left = -(UV)aiv;
}
}
}
IV count;
SV *sv;
bool infnan = FALSE;
+ const U8 gimme = GIMME_V;
- if (GIMME_V == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
+ if (gimme == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
/* TODO: think of some way of doing list-repeat overloading ??? */
sv = POPs;
SvGETMAGIC(sv);
"Negative repeat count does nothing");
}
- if (GIMME_V == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
+ if (gimme == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
dMARK;
const SSize_t items = SP - MARK;
const U8 mod = PL_op->op_flags & OPf_MOD;
if (aiv >= 0) {
auv = aiv;
auvok = 1; /* Now acting as a sign flag. */
- } else { /* 2s complement assumption for IV_MIN */
- auv = (aiv == IV_MIN) ? (UV)aiv : (UV)-aiv;
+ } else {
+ auv = -(UV)aiv;
}
}
a_valid = 1;
buv = biv;
buvok = 1;
} else
- buv = (biv == IV_MIN) ? (UV)biv : (UV)-biv;
+ buv = -(UV)biv;
}
/* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
else "IV" now, independent of how it came in.
if (SvUTF8(TARG)) {
if (len && ! utf8_to_bytes(tmps, &len)) {
- Perl_croak(aTHX_ fatal_above_ff_msg, PL_op_desc[PL_op->op_type]);
+ Perl_croak(aTHX_ FATAL_ABOVE_FF_MSG, PL_op_desc[PL_op->op_type]);
}
SvCUR(TARG) = len;
SvUTF8_off(TARG);
#if defined(__GLIBC__) || defined(__EMX__)
if (PL_reentrant_buffer->_crypt_struct_buffer) {
PL_reentrant_buffer->_crypt_struct_buffer->initialized = 0;
- /* work around glibc-2.2.5 bug */
+#if (defined(__GLIBC__) && __GLIBC__ == 2) && \
+ (defined(__GLIBC_MINOR__) && __GLIBC_MINOR__ >= 2 && __GLIBC_MINOR__ < 4)
+ /* work around glibc-2.2.5 bug, has been fixed at some
+ * time in glibc-2.3.X */
PL_reentrant_buffer->_crypt_struct_buffer->current_saltbits = 0;
+#endif
}
#endif
}
* not convert in-place. */
inplace = !SvREADONLY(source) && SvPADTMP(source);
+#ifdef USE_LOCALE_CTYPE
+
+ if (IN_LC_RUNTIME(LC_CTYPE)) {
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ }
+
+#endif
+
/* First calculate what the changed first character should be. This affects
* whether we can just swap it out, leaving the rest of the string unchanged,
* or even if have to convert the dest to UTF-8 when the source isn't */
if (! slen) { /* If empty */
need = 1; /* still need a trailing NUL */
ulen = 0;
+ *tmpbuf = '\0';
}
else if (DO_UTF8(source)) { /* Is the source utf8? */
doing_utf8 = TRUE;
/* lower case the first letter: no trickiness for any character */
#ifdef USE_LOCALE_CTYPE
if (IN_LC_RUNTIME(LC_CTYPE)) {
- _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
*tmpbuf = toLOWER_LC(*s);
}
else
goto do_uni_rules;
}
- _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
*tmpbuf = (U8) toUPPER_LC(*s); /* This would be a bug if any
locales have upper and title case
different */
SETs(dest);
}
+#ifdef USE_LOCALE_CTYPE
+
+ if (IN_LC_RUNTIME(LC_CTYPE)) {
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ }
+
+#endif
+
/* Overloaded values may have toggled the UTF-8 flag on source, so we need
to check DO_UTF8 again here. */
if (IN_UTF8_CTYPE_LOCALE) {
goto do_uni_rules;
}
- _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
for (; s < send; d++, s++)
*d = (U8) toUPPER_LC(*s);
}
SETs(dest);
}
+#ifdef USE_LOCALE_CTYPE
+
+ if (IN_LC_RUNTIME(LC_CTYPE)) {
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ }
+
+#endif
+
/* Overloaded values may have toggled the UTF-8 flag on source, so we need
to check DO_UTF8 again here. */
* whole thing in a tight loop, for speed, */
#ifdef USE_LOCALE_CTYPE
if (IN_LC_RUNTIME(LC_CTYPE)) {
- _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
for (; s < send; d++, s++)
*d = toLOWER_LC(*s);
}
SETs(dest);
send = s + len;
+
+#ifdef USE_LOCALE_CTYPE
+
+ if ( IN_LC_RUNTIME(LC_CTYPE) ) { /* Under locale */
+ _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
+ }
+
+#endif
+
if (DO_UTF8(source)) { /* UTF-8 flagged string. */
while (s < send) {
const STRLEN u = UTF8SKIP(s);
if (IN_UTF8_CTYPE_LOCALE) {
goto do_uni_folding;
}
- _CHECK_AND_WARN_PROBLEMATIC_LOCALE;
for (; s < send; d++, s++)
*d = (U8) toFOLD_LC(*s);
}
{
I32 markidx = POPMARK;
if (GIMME_V != G_ARRAY) {
- SV **mark = PL_stack_base + markidx;
+ /* don't initialize mark here, EXTEND() may move the stack */
+ SV **mark;
dSP;
EXTEND(SP, 1); /* in case no arguments, as in @empty */
+ mark = PL_stack_base + markidx;
if (++MARK <= SP)
*MARK = *SP; /* unwanted list, return last item */
else
STRLEN len;
SvUTF8_off(TARG); /* decontaminate */
- if (SP - MARK > 1)
+ if (SP - MARK > 1) {
do_join(TARG, &PL_sv_no, MARK, SP);
- else if (SP > MARK)
+ SP = MARK + 1;
+ SETs(TARG);
+ } else if (SP > MARK) {
sv_setsv(TARG, *SP);
- else {
+ SETs(TARG);
+ } else {
sv_setsv(TARG, DEFSV);
- EXTEND(SP, 1);
+ XPUSHs(TARG);
}
up = SvPV_force(TARG, len);
}
(void)SvPOK_only_UTF8(TARG);
}
- SP = MARK + 1;
- SETTARG;
}
RETURN;
}
while (++MARK <= SP) {
SV * const elemsv = *MARK;
- if (SvTYPE(av) == SVt_PVAV)
- S_localise_aelem_lval(aTHX_ av, elemsv, can_preserve);
- else
- S_localise_helem_lval(aTHX_ (HV *)av, elemsv, can_preserve);
+ if (UNLIKELY(localizing)) {
+ if (SvTYPE(av) == SVt_PVAV)
+ S_localise_aelem_lval(aTHX_ av, elemsv, can_preserve);
+ else
+ S_localise_helem_lval(aTHX_ (HV *)av, elemsv, can_preserve);
+ }
*MARK = sv_2mortal(newSV_type(SVt_PVMG));
sv_magic(*MARK,(SV *)av,PERL_MAGIC_lvref,(char *)elemsv,HEf_SVKEY);
}
https://perl5.git.perl.org / perl5.git / blobdiff