extern Pid_t getpid (void);
#endif
+/*
+ * Some BSDs and Cygwin default to POSIX math instead of IEEE.
+ * This switches them over to IEEE.
+ */
+#if defined(LIBM_LIB_VERSION)
+ _LIB_VERSION_TYPE _LIB_VERSION = _IEEE_;
+#endif
+
/* variations on pp_null */
PP(pp_stub)
}
gimme = GIMME_V;
if (gimme == G_ARRAY) {
- I32 maxarg = AvFILL((AV*)TARG) + 1;
+ const I32 maxarg = AvFILL((AV*)TARG) + 1;
EXTEND(SP, maxarg);
if (SvMAGICAL(TARG)) {
U32 i;
}
else if (gimme == G_SCALAR) {
SV* sv = sv_newmortal();
- I32 maxarg = AvFILL((AV*)TARG) + 1;
+ const I32 maxarg = AvFILL((AV*)TARG) + 1;
sv_setiv(sv, maxarg);
PUSHs(sv);
}
if (SvREADONLY(sv))
Perl_croak(aTHX_ PL_no_modify);
if (PL_op->op_private & OPpDEREF) {
- char *name;
GV *gv;
if (cUNOP->op_targ) {
STRLEN len;
SV *namesv = PAD_SV(cUNOP->op_targ);
- name = SvPV(namesv, len);
+ const char *name = SvPV(namesv, len);
gv = (GV*)NEWSV(0,0);
gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
}
else {
- name = CopSTASHPV(PL_curcop);
+ const char *name = CopSTASHPV(PL_curcop);
gv = newGVgen(name);
}
if (SvTYPE(sv) < SVt_RV)
sv_upgrade(sv, SVt_RV);
- if (SvPVX(sv)) {
- SvOOK_off(sv); /* backoff */
- if (SvLEN(sv))
- Safefree(SvPVX(sv));
- SvLEN(sv)=SvCUR(sv)=0;
+ if (SvPVX_const(sv)) {
+ SvPV_free(sv);
+ SvLEN_set(sv, 0);
+ SvCUR_set(sv, 0);
}
- SvRV(sv) = (SV*)gv;
+ SvRV_set(sv, (SV*)gv);
SvROK_on(sv);
SvSETMAGIC(sv);
goto wasref;
{
dSP;
AV *av = (AV*)TOPs;
- SV *sv = AvARYLEN(av);
- if (!sv) {
- AvARYLEN(av) = sv = NEWSV(0,0);
- sv_upgrade(sv, SVt_IV);
- sv_magic(sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0);
+ SV **sv = Perl_av_arylen_p(aTHX_ (AV*)av);
+ if (!*sv) {
+ *sv = NEWSV(0,0);
+ sv_upgrade(*sv, SVt_PVMG);
+ sv_magic(*sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0);
}
- SETs(sv);
+ SETs(*sv);
RETURN;
}
ret = &PL_sv_undef;
if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
- char *s = SvPVX(TOPs);
+ const char *s = SvPVX_const(TOPs);
if (strnEQ(s, "CORE::", 6)) {
- int code;
-
- code = keyword(s + 6, SvCUR(TOPs) - 6);
+ const int code = keyword(s + 6, SvCUR(TOPs) - 6);
if (code < 0) { /* Overridable. */
#define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
int i = 0, n = 0, seen_question = 0;
I32 oa;
char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
- if (code == -KEY_chop || code == -KEY_chomp)
+ if (code == -KEY_chop || code == -KEY_chomp
+ || code == -KEY_exec || code == -KEY_system)
goto set;
while (i < MAXO) { /* The slow way. */
if (strEQ(s + 6, PL_op_name[i])
seen_question = 1;
str[n++] = ';';
}
- else if (n && str[0] == ';' && seen_question)
- goto set; /* XXXX system, exec */
if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
&& (oa & (OA_OPTIONAL - 1)) <= OA_SCALARREF
/* But globs are already references (kinda) */
}
cv = sv_2cv(TOPs, &stash, &gv, FALSE);
if (cv && SvPOK(cv))
- ret = sv_2mortal(newSVpvn(SvPVX(cv), SvCUR(cv)));
+ ret = sv_2mortal(newSVpvn(SvPVX_const(cv), SvCUR(cv)));
set:
SETs(ret);
RETURN;
}
rv = sv_newmortal();
sv_upgrade(rv, SVt_RV);
- SvRV(rv) = sv;
+ SvRV_set(rv, sv);
SvROK_on(rv);
return rv;
}
{
dSP; dTARGET;
SV *sv;
- char *pv;
+ const char *pv;
sv = POPs;
else {
SV *ssv = POPs;
STRLEN len;
- char *ptr;
+ const char *ptr;
if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
Perl_croak(aTHX_ "Attempt to bless into a reference");
- ptr = SvPV(ssv,len);
+ ptr = SvPV_const(ssv,len);
if (ckWARN(WARN_MISC) && len == 0)
Perl_warner(aTHX_ packWARN(WARN_MISC),
"Explicit blessing to '' (assuming package main)");
GV *gv;
SV *sv;
SV *tmpRef;
- char *elem;
+ const char *elem;
dSP;
- STRLEN n_a;
sv = POPs;
- elem = SvPV(sv, n_a);
+ elem = SvPV_nolen_const(sv);
gv = (GV*)POPs;
tmpRef = Nullsv;
sv = Nullsv;
break;
case 'P':
if (strEQ(elem2, "ACKAGE")) {
- char *name = HvNAME(GvSTASH(gv));
- sv = newSVpv(name ? name : "__ANON__", 0);
+ const HEK *hek = HvNAME_HEK(GvSTASH(gv));
+ sv = hek ? newSVhek(hek) : newSVpvn("__ANON__", 8);
}
break;
case 'S':
}
break;
default:
- if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
- SvOOK_off(sv);
- Safefree(SvPVX(sv));
+ if (SvTYPE(sv) >= SVt_PV && SvPVX_const(sv) && SvLEN(sv)) {
+ SvPV_free(sv);
SvPV_set(sv, Nullch);
SvLEN_set(sv, 0);
}
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MIN)
{
- --SvIVX(TOPs);
+ SvIV_set(TOPs, SvIVX(TOPs) - 1);
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
}
else
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MAX)
{
- ++SvIVX(TOPs);
+ SvIV_set(TOPs, SvIVX(TOPs) + 1);
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
}
else
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MIN)
{
- --SvIVX(TOPs);
+ SvIV_set(TOPs, SvIVX(TOPs) - 1);
SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
}
else
if (count < 1)
SvCUR_set(TARG, 0);
else {
- IV max = count * len;
+ STRLEN max = (UV)count * len;
if (len > ((MEM_SIZE)~0)/count)
Perl_croak(aTHX_ oom_string_extend);
MEM_WRAP_CHECK_1(max, char, oom_string_extend);
- SvGROW(TARG, (count * len) + 1);
+ SvGROW(TARG, max + 1);
repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
- SvCUR(TARG) *= count;
+ SvCUR_set(TARG, SvCUR(TARG) * count);
}
*SvEND(TARG) = '\0';
}
SETn(-SvNV(sv));
else if (SvPOKp(sv)) {
STRLEN len;
- char *s = SvPV(sv, len);
+ const char *s = SvPV_const(sv, len);
if (isIDFIRST(*s)) {
sv_setpvn(TARG, "-", 1);
sv_catsv(TARG, sv);
register I32 anum;
STRLEN len;
- (void)SvPV_nomg(sv,len); /* force check for uninit var */
+ (void)SvPV_nomg_const(sv,len); /* force check for uninit var */
sv_setsv_nomg(TARG, sv);
tmps = (U8*)SvPV_force(TARG, len);
anum = len;
PP(pp_i_modulo_0)
{
/* This is the vanilla old i_modulo. */
- dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
/* This is the i_modulo with the workaround for the _moddi3 bug
* in (at least) glibc 2.2.5 (the PERL_ABS() the workaround).
* See below for pp_i_modulo. */
- dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
PP(pp_i_modulo)
{
- dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
PP(pp_hex)
{
dSP; dTARGET;
- char *tmps;
+ const char *tmps;
I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
STRLEN len;
NV result_nv;
UV result_uv;
SV* sv = POPs;
- tmps = (SvPVx(sv, len));
+ tmps = (SvPV_const(sv, len));
if (DO_UTF8(sv)) {
/* If Unicode, try to downgrade
* If not possible, croak. */
SvUTF8_on(tsv);
sv_utf8_downgrade(tsv, FALSE);
- tmps = SvPVX(tsv);
+ tmps = SvPV_const(tsv, len);
}
result_uv = grok_hex (tmps, &len, &flags, &result_nv);
if (flags & PERL_SCAN_GREATER_THAN_UV_MAX) {
PP(pp_oct)
{
dSP; dTARGET;
- char *tmps;
+ const char *tmps;
I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
STRLEN len;
NV result_nv;
UV result_uv;
SV* sv = POPs;
- tmps = (SvPVx(sv, len));
+ tmps = (SvPV_const(sv, len));
if (DO_UTF8(sv)) {
/* If Unicode, try to downgrade
* If not possible, croak. */
SvUTF8_on(tsv);
sv_utf8_downgrade(tsv, FALSE);
- tmps = SvPVX(tsv);
+ tmps = SvPV_const(tsv, len);
}
while (*tmps && len && isSPACE(*tmps))
tmps++, len--;
I32 pos;
I32 rem;
I32 fail;
- I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
- char *tmps;
- I32 arybase = PL_curcop->cop_arybase;
+ const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
+ const char *tmps;
+ const I32 arybase = PL_curcop->cop_arybase;
SV *repl_sv = NULL;
- char *repl = 0;
+ const char *repl = 0;
STRLEN repl_len;
int num_args = PL_op->op_private & 7;
bool repl_need_utf8_upgrade = FALSE;
if (num_args > 2) {
if (num_args > 3) {
repl_sv = POPs;
- repl = SvPV(repl_sv, repl_len);
+ repl = SvPV_const(repl_sv, repl_len);
repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv);
}
len = POPi;
else if (DO_UTF8(sv))
repl_need_utf8_upgrade = TRUE;
}
- tmps = SvPV(sv, curlen);
+ tmps = SvPV_const(sv, curlen);
if (DO_UTF8(sv)) {
utf8_curlen = sv_len_utf8(sv);
if (utf8_curlen == curlen)
if (repl_need_utf8_upgrade) {
repl_sv_copy = newSVsv(repl_sv);
sv_utf8_upgrade(repl_sv_copy);
- repl = SvPV(repl_sv_copy, repl_len);
+ repl = SvPV_const(repl_sv_copy, repl_len);
repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
}
sv_insert(sv, pos, rem, repl, repl_len);
else if (lvalue) { /* it's an lvalue! */
if (!SvGMAGICAL(sv)) {
if (SvROK(sv)) {
- STRLEN n_a;
- SvPV_force(sv,n_a);
+ SvPV_force_nolen(sv);
if (ckWARN(WARN_SUBSTR))
Perl_warner(aTHX_ packWARN(WARN_SUBSTR),
"Attempt to use reference as lvalue in substr");
SV *temp = Nullsv;
I32 offset;
I32 retval;
- char *tmps;
- char *tmps2;
+ const char *tmps;
+ const char *tmps2;
STRLEN biglen;
I32 arybase = PL_curcop->cop_arybase;
int big_utf8;
/* One needs to be upgraded. */
SV *bytes = little_utf8 ? big : little;
STRLEN len;
- char *p = SvPV(bytes, len);
+ const char *p = SvPV_const(bytes, len);
temp = newSVpvn(p, len);
}
if (big_utf8 && offset > 0)
sv_pos_u2b(big, &offset, 0);
- tmps = SvPV(big, biglen);
+ tmps = SvPV_const(big, biglen);
if (offset < 0)
offset = 0;
else if (offset > (I32)biglen)
STRLEN llen;
I32 offset;
I32 retval;
- char *tmps;
- char *tmps2;
+ const char *tmps;
+ const char *tmps2;
I32 arybase = PL_curcop->cop_arybase;
int big_utf8;
int little_utf8;
/* One needs to be upgraded. */
SV *bytes = little_utf8 ? big : little;
STRLEN len;
- char *p = SvPV(bytes, len);
+ const char *p = SvPV_const(bytes, len);
temp = newSVpvn(p, len);
little = temp;
}
}
- tmps2 = SvPV(little, llen);
- tmps = SvPV(big, blen);
+ tmps2 = SvPV_const(little, llen);
+ tmps = SvPV_const(big, blen);
if (MAXARG < 3)
offset = blen;
dSP; dTARGET;
SV *argsv = POPs;
STRLEN len;
- U8 *s = (U8*)SvPVx(argsv, len);
+ const U8 *s = (U8*)SvPV_const(argsv, len);
SV *tmpsv;
if (PL_encoding && SvPOK(argsv) && !DO_UTF8(argsv)) {
}
XPUSHu(DO_UTF8(argsv) ?
- utf8n_to_uvchr(s, UTF8_MAXLEN, 0, UTF8_ALLOW_ANYUV) :
+ utf8n_to_uvchr(s, UTF8_MAXBYTES, 0, UTF8_ALLOW_ANYUV) :
(*s & 0xff));
RETURN;
{
dSP; dTARGET;
char *tmps;
- UV value = POPu;
+ UV value;
- (void)SvUPGRADE(TARG,SVt_PV);
+ if (((SvIOK_notUV(TOPs) && SvIV(TOPs) < 0)
+ ||
+ (SvNOK(TOPs) && SvNV(TOPs) < 0.0))) {
+ if (IN_BYTES) {
+ value = POPu; /* chr(-1) eq chr(0xff), etc. */
+ } else {
+ (void) POPs; /* Ignore the argument value. */
+ value = UNICODE_REPLACEMENT;
+ }
+ } else {
+ value = POPu;
+ }
+
+ SvUPGRADE(TARG,SVt_PV);
if (value > 255 && !IN_BYTES) {
SvGROW(TARG, (STRLEN)UNISKIP(value)+1);
tmps = (char*)uvchr_to_utf8_flags((U8*)SvPVX(TARG), value, 0);
- SvCUR_set(TARG, tmps - SvPVX(TARG));
+ SvCUR_set(TARG, tmps - SvPVX_const(TARG));
*tmps = '\0';
(void)SvPOK_only(TARG);
SvUTF8_on(TARG);
PP(pp_crypt)
{
- dSP; dTARGET;
#ifdef HAS_CRYPT
+ dSP; dTARGET;
dPOPTOPssrl;
- STRLEN n_a;
STRLEN len;
- char *tmps = SvPV(left, len);
+ const char *tmps = SvPV_const(left, len);
if (DO_UTF8(left)) {
/* If Unicode, try to downgrade.
SvUTF8_on(tsv);
sv_utf8_downgrade(tsv, FALSE);
- tmps = SvPVX(tsv);
+ tmps = SvPV_const(tsv, len);
}
# ifdef USE_ITHREADS
# ifdef HAS_CRYPT_R
# endif /* HAS_CRYPT_R */
# endif /* USE_ITHREADS */
# ifdef FCRYPT
- sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
+ sv_setpv(TARG, fcrypt(tmps, SvPV_nolen_const(right)));
# else
- sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
+ sv_setpv(TARG, PerlProc_crypt(tmps, SvPV_nolen_const(right)));
# endif
SETs(TARG);
RETURN;
{
dSP;
SV *sv = TOPs;
- register U8 *s;
+ const U8 *s;
STRLEN slen;
SvGETMAGIC(sv);
if (DO_UTF8(sv) &&
- (s = (U8*)SvPV_nomg(sv, slen)) && slen &&
+ (s = (const U8*)SvPV_nomg_const(sv, slen)) && slen &&
UTF8_IS_START(*s)) {
- U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
+ U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
STRLEN ulen;
STRLEN tculen;
}
}
else {
+ U8 *s1;
if (!SvPADTMP(sv) || SvREADONLY(sv)) {
dTARGET;
SvUTF8_off(TARG); /* decontaminate */
sv = TARG;
SETs(sv);
}
- s = (U8*)SvPV_force_nomg(sv, slen);
- if (*s) {
+ s1 = (U8*)SvPV_force_nomg(sv, slen);
+ if (*s1) {
if (IN_LOCALE_RUNTIME) {
TAINT;
SvTAINTED_on(sv);
- *s = toUPPER_LC(*s);
+ *s1 = toUPPER_LC(*s1);
}
else
- *s = toUPPER(*s);
+ *s1 = toUPPER(*s1);
}
}
SvSETMAGIC(sv);
{
dSP;
SV *sv = TOPs;
- register U8 *s;
+ const U8 *s;
STRLEN slen;
SvGETMAGIC(sv);
if (DO_UTF8(sv) &&
- (s = (U8*)SvPV_nomg(sv, slen)) && slen &&
+ (s = (const U8*)SvPV_nomg_const(sv, slen)) && slen &&
UTF8_IS_START(*s)) {
STRLEN ulen;
- U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
+ U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
U8 *tend;
UV uv;
}
}
else {
+ U8 *s1;
if (!SvPADTMP(sv) || SvREADONLY(sv)) {
dTARGET;
SvUTF8_off(TARG); /* decontaminate */
sv = TARG;
SETs(sv);
}
- s = (U8*)SvPV_force_nomg(sv, slen);
- if (*s) {
+ s1 = (U8*)SvPV_force_nomg(sv, slen);
+ if (*s1) {
if (IN_LOCALE_RUNTIME) {
TAINT;
SvTAINTED_on(sv);
- *s = toLOWER_LC(*s);
+ *s1 = toLOWER_LC(*s1);
}
else
- *s = toLOWER(*s);
+ *s1 = toLOWER(*s1);
}
}
SvSETMAGIC(sv);
{
dSP;
SV *sv = TOPs;
- register U8 *s;
STRLEN len;
SvGETMAGIC(sv);
dTARGET;
STRLEN ulen;
register U8 *d;
- U8 *send;
- U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
+ const U8 *s;
+ const U8 *send;
+ U8 tmpbuf[UTF8_MAXBYTES+1];
- s = (U8*)SvPV_nomg(sv,len);
+ s = (const U8*)SvPV_nomg_const(sv,len);
if (!len) {
SvUTF8_off(TARG); /* decontaminate */
sv_setpvn(TARG, "", 0);
SETs(TARG);
}
else {
- STRLEN nchar = utf8_length(s, s + len);
+ STRLEN min = len + 1;
- (void)SvUPGRADE(TARG, SVt_PV);
- SvGROW(TARG, (nchar * UTF8_MAXLEN_UCLC) + 1);
+ SvUPGRADE(TARG, SVt_PV);
+ SvGROW(TARG, min);
(void)SvPOK_only(TARG);
d = (U8*)SvPVX(TARG);
send = s + len;
while (s < send) {
+ STRLEN u = UTF8SKIP(s);
+
toUPPER_utf8(s, tmpbuf, &ulen);
+ if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) {
+ /* If the eventually required minimum size outgrows
+ * the available space, we need to grow. */
+ UV o = d - (U8*)SvPVX_const(TARG);
+
+ /* If someone uppercases one million U+03B0s we
+ * SvGROW() one million times. Or we could try
+ * guessing how much to allocate without allocating
+ * too much. Such is life. */
+ SvGROW(TARG, min);
+ d = (U8*)SvPVX(TARG) + o;
+ }
Copy(tmpbuf, d, ulen, U8);
d += ulen;
- s += UTF8SKIP(s);
+ s += u;
}
*d = '\0';
SvUTF8_on(TARG);
- SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+ SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
SETs(TARG);
}
}
else {
+ U8 *s;
if (!SvPADTMP(sv) || SvREADONLY(sv)) {
dTARGET;
SvUTF8_off(TARG); /* decontaminate */
}
s = (U8*)SvPV_force_nomg(sv, len);
if (len) {
- register U8 *send = s + len;
+ const register U8 *send = s + len;
if (IN_LOCALE_RUNTIME) {
TAINT;
{
dSP;
SV *sv = TOPs;
- register U8 *s;
STRLEN len;
SvGETMAGIC(sv);
if (DO_UTF8(sv)) {
dTARGET;
+ const U8 *s;
STRLEN ulen;
register U8 *d;
- U8 *send;
- U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
+ const U8 *send;
+ U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
- s = (U8*)SvPV_nomg(sv,len);
+ s = (const U8*)SvPV_nomg_const(sv,len);
if (!len) {
SvUTF8_off(TARG); /* decontaminate */
sv_setpvn(TARG, "", 0);
SETs(TARG);
}
else {
- STRLEN nchar = utf8_length(s, s + len);
+ STRLEN min = len + 1;
- (void)SvUPGRADE(TARG, SVt_PV);
- SvGROW(TARG, (nchar * UTF8_MAXLEN_UCLC) + 1);
+ SvUPGRADE(TARG, SVt_PV);
+ SvGROW(TARG, min);
(void)SvPOK_only(TARG);
d = (U8*)SvPVX(TARG);
send = s + len;
while (s < send) {
+ STRLEN u = UTF8SKIP(s);
UV uv = toLOWER_utf8(s, tmpbuf, &ulen);
-#define GREEK_CAPITAL_LETTER_SIGMA 0x03A3 /* Unicode */
+
+#define GREEK_CAPITAL_LETTER_SIGMA 0x03A3 /* Unicode U+03A3 */
if (uv == GREEK_CAPITAL_LETTER_SIGMA) {
/*
* Now if the sigma is NOT followed by
* then it should be mapped to 0x03C2,
* (GREEK SMALL LETTER FINAL SIGMA),
* instead of staying 0x03A3.
- * See lib/unicore/SpecCase.txt.
+ * "should be": in other words,
+ * this is not implemented yet.
+ * See lib/unicore/SpecialCasing.txt.
*/
}
+ if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) {
+ /* If the eventually required minimum size outgrows
+ * the available space, we need to grow. */
+ UV o = d - (U8*)SvPVX_const(TARG);
+
+ /* If someone lowercases one million U+0130s we
+ * SvGROW() one million times. Or we could try
+ * guessing how much to allocate without allocating.
+ * too much. Such is life. */
+ SvGROW(TARG, min);
+ d = (U8*)SvPVX(TARG) + o;
+ }
Copy(tmpbuf, d, ulen, U8);
d += ulen;
- s += UTF8SKIP(s);
+ s += u;
}
*d = '\0';
SvUTF8_on(TARG);
- SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+ SvCUR_set(TARG, d - (U8*)SvPVX_const(TARG));
SETs(TARG);
}
}
else {
+ U8 *s;
if (!SvPADTMP(sv) || SvREADONLY(sv)) {
dTARGET;
SvUTF8_off(TARG); /* decontaminate */
dSP; dTARGET;
SV *sv = TOPs;
STRLEN len;
- register char *s = SvPV(sv,len);
+ const register char *s = SvPV_const(sv,len);
register char *d;
SvUTF8_off(TARG); /* decontaminate */
if (len) {
- (void)SvUPGRADE(TARG, SVt_PV);
+ SvUPGRADE(TARG, SVt_PV);
SvGROW(TARG, (len * 2) + 1);
d = SvPVX(TARG);
if (DO_UTF8(sv)) {
}
}
*d = '\0';
- SvCUR_set(TARG, d - SvPVX(TARG));
+ SvCUR_set(TARG, d - SvPVX_const(TARG));
(void)SvPOK_only_UTF8(TARG);
}
else
dSP;
HV *hash = (HV*)POPs;
HE *entry;
- I32 gimme = GIMME_V;
+ const I32 gimme = GIMME_V;
PUTBACK;
/* might clobber stack_sp */
PP(pp_delete)
{
dSP;
- I32 gimme = GIMME_V;
- I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
+ const I32 gimme = GIMME_V;
+ const I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
SV *sv;
HV *hv;
if (lval) {
if (!svp || *svp == &PL_sv_undef) {
- STRLEN n_a;
- DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
+ DIE(aTHX_ PL_no_helem_sv, keysv);
}
if (localizing) {
if (preeminent)
save_helem(hv, keysv, svp);
else {
STRLEN keylen;
- char *key = SvPV(keysv, keylen);
+ const char *key = SvPV_const(keysv, keylen);
SAVEDELETE(hv, savepvn(key,keylen), keylen);
}
}
PP(pp_splice)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
register AV *ary = (AV*)*++MARK;
register SV **src;
register SV **dst;
*dst-- = *src--;
}
dst = AvARRAY(ary);
- SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
+ SvPV_set(ary, (char*)(AvARRAY(ary) - diff)); /* diff is negative */
AvMAX(ary) += diff;
}
else {
dst = src - diff;
Move(src, dst, offset, SV*);
}
- SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
+ SvPV_set(ary, (char*)(AvARRAY(ary) - diff));/* diff is positive */
AvMAX(ary) += diff;
AvFILLp(ary) += diff;
}
PP(pp_push)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv = &PL_sv_undef;
MAGIC *mg;
PP(pp_unshift)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv;
register I32 i = 0;
if (len > 1) {
if (DO_UTF8(TARG)) { /* first reverse each character */
U8* s = (U8*)SvPVX(TARG);
- U8* send = (U8*)(s + len);
+ const U8* send = (U8*)(s + len);
while (s < send) {
if (UTF8_IS_INVARIANT(*s)) {
s++;
PP(pp_split)
{
- dSP; dTARG;
+ dVAR; dSP; dTARG;
AV *ary;
register IV limit = POPi; /* note, negative is forever */
SV *sv = POPs;
STRLEN len;
- register char *s = SvPV(sv, len);
+ register const char *s = SvPV_const(sv, len);
bool do_utf8 = DO_UTF8(sv);
- char *strend = s + len;
+ const char *strend = s + len;
register PMOP *pm;
register REGEXP *rx;
register SV *dstr;
- register char *m;
+ register const char *m;
I32 iters = 0;
- STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (strend - s);
+ const STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (strend - s);
I32 maxiters = slen + 10;
I32 i;
- char *orig;
+ const char *orig;
I32 origlimit = limit;
I32 realarray = 0;
I32 base;
- I32 gimme = GIMME_V;
- I32 oldsave = PL_savestack_ix;
+ const I32 gimme = GIMME_V;
+ const I32 oldsave = PL_savestack_ix;
I32 make_mortal = 1;
bool multiline = 0;
MAGIC *mg = (MAGIC *) NULL;
len = rx->minlen;
if (len == 1 && !(rx->reganch & ROPT_UTF8) && !tail) {
- STRLEN n_a;
- char c = *SvPV(csv, n_a);
+ char c = *SvPV_nolen_const(csv);
while (--limit) {
/*SUPPRESS 530*/
for (m = s; m < strend && *m != c; m++) ;
}
}
else {
-#ifndef lint
while (s < strend && --limit &&
(m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
csv, multiline ? FBMrf_MULTILINE : 0)) )
-#endif
{
dstr = newSVpvn(s, m-s);
if (make_mortal)
while (s < strend && --limit)
{
PUTBACK;
- i = CALLREGEXEC(aTHX_ rx, s, strend, orig, 1 , sv, NULL, 0);
+ i = CALLREGEXEC(aTHX_ rx, (char*)s, (char*)strend, (char*)orig, 1 ,
+ sv, NULL, 0);
SPAGAIN;
if (i == 0)
break;
* indent-tabs-mode: t
* End:
*
- * vim: shiftwidth=4:
-*/
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
https://perl5.git.perl.org / perl5.git / blobdiff