{
MGS* mgs;
assert(SvMAGICAL(sv));
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
/* Turning READONLY off for a copy-on-write scalar is a bad idea. */
if (SvIsCOW(sv))
sv_force_normal(sv);
}
if (DO_UTF8(sv)) {
- U8 *s = (U8*)SvPV(sv, len);
+ const U8 *s = (U8*)SvPV_const(sv, len);
len = Perl_utf8_length(aTHX_ s, s + len);
}
else
- (void)SvPV(sv, len);
+ (void)SvPV_const(sv, len);
return len;
}
{
(void)sv; (void)mg;
Perl_croak(aTHX_ PL_no_modify);
- /* NOT REACHED */
-#ifndef HASATTRIBUTE
- /* No __attribute__, so the compiler doesn't know that croak never returns
- */
- return 0;
-#endif
+ NORETURN_FUNCTION_END;
}
U32
i = t1 - s1;
getlen:
if (i > 0 && RX_MATCH_UTF8(rx)) {
- char *s = rx->subbeg + s1;
- char *send = rx->subbeg + t1;
+ const char * const s = rx->subbeg + s1;
+ const U8 *ep;
+ STRLEN el;
i = t1 - s1;
- if (is_utf8_string((U8*)s, i))
- i = Perl_utf8_length(aTHX_ (U8*)s, (U8*)send);
+ if (is_utf8_string_loclen((U8*)s, i, &ep, &el))
+ i = el;
}
if (i < 0)
Perl_croak(aTHX_ "panic: magic_len: %"IVdf, (IV)i);
}
magic_get(sv,mg);
if (!SvPOK(sv) && SvNIOK(sv)) {
- STRLEN n_a;
- sv_2pv(sv, &n_a);
+ sv_2pv(sv, 0);
}
if (SvPOK(sv))
return SvCUR(sv);
case '\001': /* ^A */
sv_setsv(sv, PL_bodytarget);
break;
- case '\003': /* ^C */
- sv_setiv(sv, (IV)PL_minus_c);
+ case '\003': /* ^C, ^CHILD_ERROR_NATIVE */
+ if (*(mg->mg_ptr+1) == '\0') {
+ sv_setiv(sv, (IV)PL_minus_c);
+ }
+ else if (strEQ(mg->mg_ptr, "\003HILD_ERROR_NATIVE")) {
+ sv_setiv(sv, (IV)STATUS_NATIVE);
+ }
break;
case '\004': /* ^D */
if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1)
sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
else
- sv_setpv(sv,"");
+ sv_setpvn(sv,"",0);
}
#else
#ifdef OS2
PerlProc_GetOSError(sv, dwErr);
}
else
- sv_setpv(sv, "");
+ sv_setpvn(sv, "", 0);
SetLastError(dwErr);
}
#else
sv_setsv(sv,&PL_sv_undef);
break;
case '.':
-#ifndef lint
if (GvIO(PL_last_in_gv)) {
sv_setiv(sv, (IV)IoLINES(GvIOp(PL_last_in_gv)));
}
-#endif
break;
case '?':
{
s = GvENAME(PL_defoutgv);
sv_setpv(sv,s);
break;
-#ifndef lint
case '=':
if (GvIOp(PL_defoutgv))
sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(PL_defoutgv)));
if (GvIOp(PL_defoutgv))
sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv)));
break;
-#endif
case ':':
break;
case '/':
case '(':
sv_setiv(sv, (IV)PL_gid);
#ifdef HAS_GETGROUPS
- Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_gid);
+ Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, (long unsigned int)PL_gid);
#endif
goto add_groups;
case ')':
sv_setiv(sv, (IV)PL_egid);
#ifdef HAS_GETGROUPS
- Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_egid);
+ Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, (long unsigned int)PL_egid);
#endif
add_groups:
#ifdef HAS_GETGROUPS
{
Groups_t gary[NGROUPS];
- i = getgroups(NGROUPS,gary);
- while (--i >= 0)
- Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, gary[i]);
+ I32 j = getgroups(NGROUPS,gary);
+ while (--j >= 0)
+ Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, (long unsigned int)gary[j]);
}
#endif
(void)SvIOK_on(sv); /* what a wonderful hack! */
Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
{
dVAR;
- register char *s;
- char *ptr;
+ const char *s;
+ const char *ptr;
STRLEN len, klen;
- s = SvPV(sv,len);
- ptr = MgPV(mg,klen);
+ s = SvPV_const(sv,len);
+ ptr = MgPV_const(mg,klen);
my_setenv(ptr, s);
#ifdef DYNAMIC_ENV_FETCH
if (!len) {
SV **valp;
if ((valp = hv_fetch(GvHVn(PL_envgv), ptr, klen, FALSE)))
- s = SvPV(*valp, len);
+ s = SvPV_const(*valp, len);
}
#endif
}
#endif /* VMS */
if (s && klen == 4 && strEQ(ptr,"PATH")) {
- char *strend = s + len;
+ const char *strend = s + len;
while (s < strend) {
char tmpbuf[256];
int
Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg)
{
- STRLEN n_a;
(void)sv;
- my_setenv(MgPV(mg,n_a),Nullch);
+ my_setenv(MgPV_nolen_const(mg),Nullch);
return 0;
}
#else
if (PL_localizing) {
HE* entry;
- STRLEN n_a;
magic_clear_all_env(sv,mg);
hv_iterinit((HV*)sv);
while ((entry = hv_iternext((HV*)sv))) {
I32 keylen;
my_setenv(hv_iterkey(entry, &keylen),
- SvPV(hv_iterval((HV*)sv, entry), n_a));
+ SvPV_nolen_const(hv_iterval((HV*)sv, entry)));
}
}
#endif
static void
restore_sigmask(pTHX_ SV *save_sv)
{
- sigset_t *ossetp = (sigset_t *) SvPV_nolen( save_sv );
+ const sigset_t *ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
(void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
}
#endif
Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
{
I32 i;
- STRLEN n_a;
/* Are we fetching a signal entry? */
- i = whichsig(MgPV(mg,n_a));
+ i = whichsig(MgPV_nolen_const(mg));
if (i > 0) {
if(PL_psig_ptr[i])
sv_setsv(sv,PL_psig_ptr[i]);
* refactoring might be in order.
*/
dVAR;
- STRLEN n_a;
- register const char *s = MgPV(mg,n_a);
+ register const char *s = MgPV_nolen_const(mg);
(void)sv;
if (*s == '_') {
SV** svp = 0;
SV* save_sv;
#endif
- register const char *s = MgPV(mg,len);
+ register const char *s = MgPV_const(mg,len);
if (*s == '_') {
if (strEQ(s,"__DIE__"))
svp = &PL_diehook;
if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) {
SV *key;
- if (HvEITER(hv))
+ if (HvEITER_get(hv))
/* we are in an iteration so the hash cannot be empty */
return &PL_sv_yes;
/* no xhv_eiter so now use FIRSTKEY */
key = sv_newmortal();
magic_nextpack((SV*)hv, mg, key);
- HvEITER(hv) = NULL; /* need to reset iterator */
+ HvEITER_set(hv, NULL); /* need to reset iterator */
return SvOK(key) ? &PL_sv_yes : &PL_sv_no;
}
I32 i;
GV* gv;
SV** svp;
- STRLEN n_a;
gv = PL_DBline;
i = SvTRUE(sv);
svp = av_fetch(GvAV(gv),
- atoi(MgPV(mg,n_a)), FALSE);
+ atoi(MgPV_nolen_const(mg)), FALSE);
if (svp && SvIOKp(*svp) && (o = INT2PTR(OP*,SvIVX(*svp)))) {
/* set or clear breakpoint in the relevant control op */
if (i)
{
STRLEN len;
SV * const lsv = LvTARG(sv);
- const char * const tmps = SvPV(lsv,len);
+ const char * const tmps = SvPV_const(lsv,len);
I32 offs = LvTARGOFF(sv);
I32 rem = LvTARGLEN(sv);
(void)mg;
Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
{
STRLEN len;
- char *tmps = SvPV(sv, len);
+ const char *tmps = SvPV_const(sv, len);
SV * const lsv = LvTARG(sv);
I32 lvoff = LvTARGOFF(sv);
I32 lvlen = LvTARGLEN(sv);
case '\004': /* ^D */
#ifdef DEBUGGING
- s = SvPV_nolen(sv);
+ s = SvPV_nolen_const(sv);
PL_debug = get_debug_opts(&s, 0) | DEBUG_TOP_FLAG;
DEBUG_x(dump_all());
#else
STRLEN len, i;
int accumulate = 0 ;
int any_fatals = 0 ;
- const char * const ptr = (char*)SvPV(sv, len) ;
+ const char * const ptr = SvPV_const(sv, len) ;
for (i = 0 ; i < len ; ++i) {
accumulate |= ptr[i] ;
any_fatals |= (ptr[i] & 0xAA) ;
STATUS_NATIVE_SET((U32)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)));
else
#endif
- STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ STATUS_UNIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '!':
{
case ')':
#ifdef HAS_SETGROUPS
{
- const char *p = SvPV(sv, len);
+ const char *p = SvPV_const(sv, len);
Groups_t gary[NGROUPS];
while (isSPACE(*p))
* show a string from the process struct and provide
* the setproctitle() routine to manipulate that. */
{
- s = SvPV(sv, len);
+ s = SvPV_const(sv, len);
# if __FreeBSD_version > 410001
/* The leading "-" removes the "perl: " prefix,
* but not the "(perl) suffix from the ps(1)
#if defined(__hpux) && defined(PSTAT_SETCMD)
{
union pstun un;
- s = SvPV(sv, len);
+ s = SvPV_const(sv, len);
un.pst_command = (char *)s;
pstat(PSTAT_SETCMD, un, len, 0, 0);
}
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
{
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
/* While magic was saved (and off) sv_setsv may well have seen
this SV as a prime candidate for COW. */
if (SvIsCOW(sv))
#endif
}
-
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
projects / p5sagit/p5-mst-13.2.git / blobdiff