{
MGS* mgs;
assert(SvMAGICAL(sv));
+#ifdef PERL_COPY_ON_WRITE
+ /* Turning READONLY off for a copy-on-write scalar is a bad idea. */
+ if (SvIsCOW(sv))
+ sv_force_normal(sv);
+#endif
SAVEDESTRUCTOR_X(restore_magic, INT2PTR(void*, (IV)mgs_ix));
paren = mg->mg_len;
if (paren < 0)
return 0;
- if (paren <= rx->nparens &&
+ if (paren <= (I32)rx->nparens &&
(s = rx->startp[paren]) != -1 &&
(t = rx->endp[paren]) != -1)
{
paren = atoi(mg->mg_ptr); /* $& is in [0] */
getparen:
- if (paren <= rx->nparens &&
+ if (paren <= (I32)rx->nparens &&
(s1 = rx->startp[paren]) != -1 &&
(t1 = rx->endp[paren]) != -1)
{
char *s = rx->subbeg + s1;
char *send = rx->subbeg + t1;
+ i = t1 - s1;
if (is_utf8_string((U8*)s, i))
i = Perl_utf8_length(aTHX_ (U8*)s, (U8*)send);
}
*/
paren = atoi(mg->mg_ptr); /* $& is in [0] */
getparen:
- if (paren <= rx->nparens &&
+ if (paren <= (I32)rx->nparens &&
(s1 = rx->startp[paren]) != -1 &&
(t1 = rx->endp[paren]) != -1)
{
getrx:
if (i >= 0) {
- bool was_tainted = FALSE;
- if (PL_tainting) {
- was_tainted = PL_tainted;
- PL_tainted = FALSE;
- }
sv_setpvn(sv, s, i);
- if (PL_reg_match_utf8 && is_utf8_string((U8*)s, i))
+ if (PL_reg_match_utf8 && is_utf8_string((U8*)s, i))
SvUTF8_on(sv);
else
SvUTF8_off(sv);
- if (PL_tainting)
- PL_tainted = (was_tainted || RX_MATCH_TAINTED(rx));
+ if (PL_tainting) {
+ if (RX_MATCH_TAINTED(rx)) {
+ MAGIC* mg = SvMAGIC(sv);
+ MAGIC* mgt;
+ PL_tainted = 1;
+ SvMAGIC(sv) = mg->mg_moremagic;
+ SvTAINT(sv);
+ if ((mgt = SvMAGIC(sv))) {
+ mg->mg_moremagic = mgt;
+ SvMAGIC(sv) = mg;
+ }
+ } else
+ SvTAINTED_off(sv);
+ }
break;
}
}
#ifdef VMS
if (s && klen == 8 && strEQ(ptr, "DCL$PATH")) {
char pathbuf[256], eltbuf[256], *cp, *elt = s;
- struct stat sbuf;
+ Stat_t sbuf;
int i = 0, j = 0;
do { /* DCL$PATH may be a search list */
while (s < strend) {
char tmpbuf[256];
- struct stat st;
+ Stat_t st;
I32 i;
s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
s, strend, ':', &i);
#if defined(VMS) || defined(EPOC)
Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
#else
-# if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
+# if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
PerlEnv_clearenv();
-# else
-# ifdef USE_ENVIRON_ARRAY
-# ifndef PERL_USE_SAFE_PUTENV
+# else
+# ifdef USE_ENVIRON_ARRAY
+# if defined(USE_ITHREADS)
+ /* only the parent thread can clobber the process environment */
+ if (PL_curinterp == aTHX)
+# endif
+ {
+# ifndef PERL_USE_SAFE_PUTENV
I32 i;
if (environ == PL_origenviron)
else
for (i = 0; environ[i]; i++)
safesysfree(environ[i]);
-# endif /* PERL_USE_SAFE_PUTENV */
+# endif /* PERL_USE_SAFE_PUTENV */
environ[0] = Nullch;
-
-# endif /* USE_ENVIRON_ARRAY */
+ }
+# endif /* USE_ENVIRON_ARRAY */
# endif /* PERL_IMPLICIT_SYS || WIN32 */
#endif /* VMS || EPC */
return 0;
svp = av_fetch(GvAV(gv),
atoi(MgPV(mg,n_a)), FALSE);
if (svp && SvIOKp(*svp) && (o = INT2PTR(OP*,SvIVX(*svp))))
- o->op_private = i;
+ o->op_private = (U8)i;
return 0;
}
if (pos < 0)
pos = 0;
}
- else if (pos > len)
+ else if (pos > (SSize_t)len)
pos = len;
if (ulen) {
if (SvUTF8(lsv))
sv_pos_u2b(lsv, &offs, &rem);
- if (offs > len)
+ if (offs > (I32)len)
offs = len;
- if (rem + offs > len)
+ if (rem + offs > (I32)len)
rem = len - offs;
sv_setpvn(sv, tmps + offs, (STRLEN)rem);
if (SvUTF8(lsv))
if (LvTARGLEN(sv)) {
if (mg->mg_obj) {
SV *ahv = LvTARG(sv);
- if (SvTYPE(ahv) == SVt_PVHV) {
- HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, FALSE, 0);
- if (he)
- targ = HeVAL(he);
- }
- else {
- SV **svp = avhv_fetch_ent((AV*)ahv, mg->mg_obj, FALSE, 0);
- if (svp)
- targ = *svp;
- }
+ HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, FALSE, 0);
+ if (he)
+ targ = HeVAL(he);
}
else {
AV* av = (AV*)LvTARG(sv);
if (mg->mg_obj) {
SV *ahv = LvTARG(sv);
STRLEN n_a;
- if (SvTYPE(ahv) == SVt_PVHV) {
- HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, TRUE, 0);
- if (he)
- value = HeVAL(he);
- }
- else {
- SV **svp = avhv_fetch_ent((AV*)ahv, mg->mg_obj, TRUE, 0);
- if (svp)
- value = *svp;
- }
+ HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, TRUE, 0);
+ if (he)
+ value = HeVAL(he);
if (!value || value == &PL_sv_undef)
Perl_croak(aTHX_ PL_no_helem, SvPV(mg->mg_obj, n_a));
}
sv_setsv(PL_bodytarget, sv);
break;
case '\003': /* ^C */
- PL_minus_c = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ PL_minus_c = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '\004': /* ^D */
}
}
else if (strEQ(mg->mg_ptr+1, "IDE_SYSTEM_CALLS"))
- PL_widesyscalls = SvTRUE(sv);
+ PL_widesyscalls = (bool)SvTRUE(sv);
break;
case '.':
if (PL_localizing) {
STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '!':
+ {
+#ifdef VMS
+# define PERL_VMS_BANG vaxc$errno
+#else
+# define PERL_VMS_BANG 0
+#endif
SETERRNO(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0,
- (SvIV(sv) == EVMSERR) ? 4 : vaxc$errno);
+ (SvIV(sv) == EVMSERR) ? 4 : PERL_VMS_BANG);
+ }
break;
case '<':
PL_uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
break;
}
/* can grab env area too? */
- if (PL_origenviron && (PL_origenviron[0] == s + 1)) {
+ if (PL_origenviron
+#ifdef USE_ITHREADS
+ && PL_curinterp == aTHX
+#endif
+ && (PL_origenviron[0] == s + 1))
+ {
my_setenv("NoNe SuCh", Nullch);
/* force copy of environment */
for (i = 0; PL_origenviron[i]; i++)
}
s = SvPV_force(sv,len);
i = len;
- if (i >= PL_origalen) {
+ if (i >= (I32)PL_origalen) {
i = PL_origalen;
/* don't allow system to limit $0 seen by script */
/* SvCUR_set(sv, i); *SvEND(sv) = '\0'; */
Copy(s, PL_origargv[0], i, char);
s = PL_origargv[0]+i;
*s++ = '\0';
- while (++i < PL_origalen)
- *s++ = ' ';
- s = PL_origargv[0]+i;
+ while (++i < (I32)PL_origalen)
+ *s++ = '\0';
for (i = 1; i < PL_origargc; i++)
PL_origargv[i] = Nullch;
}