{
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;
}
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)");
SV *tmpRef;
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")) {
- const 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':
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_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--;
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)) {
{
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);
#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_MAXBYTES_CASE+1];
STRLEN ulen;
}
}
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_MAXBYTES_CASE+1];
}
}
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;
+ 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);
else {
STRLEN min = len + 1;
- (void)SvUPGRADE(TARG, SVt_PV);
+ SvUPGRADE(TARG, SVt_PV);
SvGROW(TARG, min);
(void)SvPOK_only(TARG);
d = (U8*)SvPVX(TARG);
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(TARG);
+ UV o = d - (U8*)SvPVX_const(TARG);
/* If someone uppercases one million U+03B0s we
* SvGROW() one million times. Or we could try
}
*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;
+ 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);
else {
STRLEN min = len + 1;
- (void)SvUPGRADE(TARG, SVt_PV);
+ SvUPGRADE(TARG, SVt_PV);
SvGROW(TARG, min);
(void)SvPOK_only(TARG);
d = (U8*)SvPVX(TARG);
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(TARG);
+ UV o = d - (U8*)SvPVX_const(TARG);
/* If someone lowercases one million U+0130s we
* SvGROW() one million times. Or we could try
}
*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
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);
}
}
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++;
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;
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;
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;
https://perl5.git.perl.org / perl5.git / blobdiff