summaryrefslogtreecommitdiffstats
path: root/contrib/perl5/mg.c
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/perl5/mg.c')
-rw-r--r--contrib/perl5/mg.c98
1 files changed, 62 insertions, 36 deletions
diff --git a/contrib/perl5/mg.c b/contrib/perl5/mg.c
index 9dfbd4f..d69fd53 100644
--- a/contrib/perl5/mg.c
+++ b/contrib/perl5/mg.c
@@ -1,6 +1,6 @@
/* mg.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
@@ -248,7 +248,9 @@ mg_copy(SV *sv, SV *nsv, char *key, I32 klen)
MAGIC* mg;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
if (isUPPER(mg->mg_type)) {
- sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen);
+ sv_magic(nsv,
+ mg->mg_type == 'P' ? SvTIED_obj(sv, mg) : mg->mg_obj,
+ toLOWER(mg->mg_type), key, klen);
count++;
}
}
@@ -339,8 +341,10 @@ magic_len(SV *sv, MAGIC *mg)
return (STRLEN)PL_orslen;
}
magic_get(sv,mg);
- if (!SvPOK(sv) && SvNIOK(sv))
- sv_2pv(sv, &PL_na);
+ if (!SvPOK(sv) && SvNIOK(sv)) {
+ STRLEN n_a;
+ sv_2pv(sv, &n_a);
+ }
if (SvPOK(sv))
return SvCUR(sv);
return 0;
@@ -360,6 +364,9 @@ magic_get(SV *sv, MAGIC *mg)
case '\001': /* ^A */
sv_setsv(sv, PL_bodytarget);
break;
+ case '\003': /* ^C */
+ sv_setiv(sv, (IV)PL_minus_c);
+ break;
case '\004': /* ^D */
sv_setiv(sv, (IV)(PL_debug & 32767));
break;
@@ -382,8 +389,11 @@ magic_get(SV *sv, MAGIC *mg)
sv_setnv(sv, (double)errno);
sv_setpv(sv, errno ? Strerror(errno) : "");
} else {
- if (errno != errno_isOS2)
- Perl_rc = _syserrno();
+ if (errno != errno_isOS2) {
+ int tmp = _syserrno();
+ if (tmp) /* 2nd call to _syserrno() makes it 0 */
+ Perl_rc = tmp;
+ }
sv_setnv(sv, (double)Perl_rc);
sv_setpv(sv, os2error(Perl_rc));
}
@@ -716,7 +726,8 @@ magic_setenv(SV *sv, MAGIC *mg)
int
magic_clearenv(SV *sv, MAGIC *mg)
{
- my_setenv(MgPV(mg,PL_na),Nullch);
+ STRLEN n_a;
+ my_setenv(MgPV(mg,n_a),Nullch);
return 0;
}
@@ -729,12 +740,13 @@ magic_set_all_env(SV *sv, MAGIC *mg)
dTHR;
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), PL_na));
+ SvPV(hv_iterval((HV*)sv, entry), n_a));
}
}
#endif
@@ -757,7 +769,7 @@ magic_clear_all_env(SV *sv, MAGIC *mg)
*end = '\0';
my_setenv(cur,Nullch);
*end = '=';
- cur += strlen(end+1)+1;
+ cur = end + strlen(end+1)+2;
}
else if ((len = strlen(cur)))
cur += len+1;
@@ -782,8 +794,9 @@ int
magic_getsig(SV *sv, MAGIC *mg)
{
I32 i;
+ STRLEN n_a;
/* Are we fetching a signal entry? */
- i = whichsig(MgPV(mg,PL_na));
+ i = whichsig(MgPV(mg,n_a));
if (i) {
if(psig_ptr[i])
sv_setsv(sv,psig_ptr[i]);
@@ -805,8 +818,9 @@ int
magic_clearsig(SV *sv, MAGIC *mg)
{
I32 i;
+ STRLEN n_a;
/* Are we clearing a signal entry? */
- i = whichsig(MgPV(mg,PL_na));
+ i = whichsig(MgPV(mg,n_a));
if (i) {
if(psig_ptr[i]) {
SvREFCNT_dec(psig_ptr[i]);
@@ -827,8 +841,9 @@ magic_setsig(SV *sv, MAGIC *mg)
register char *s;
I32 i;
SV** svp;
+ STRLEN n_a;
- s = MgPV(mg,PL_na);
+ s = MgPV(mg,n_a);
if (*s == '_') {
if (strEQ(s,"__DIE__"))
svp = &PL_diehook;
@@ -865,7 +880,7 @@ magic_setsig(SV *sv, MAGIC *mg)
*svp = SvREFCNT_inc(sv);
return 0;
}
- s = SvPV_force(sv,PL_na);
+ s = SvPV_force(sv,n_a);
if (strEQ(s,"IGNORE")) {
if (i)
(void)rsignal(i, SIG_IGN);
@@ -922,7 +937,7 @@ magic_getnkeys(SV *sv, MAGIC *mg)
if (hv) {
(void) hv_iterinit(hv);
- if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
+ if (! SvTIED_mg((SV*)hv, 'P'))
i = HvKEYS(hv);
else {
/*SUPPRESS 560*/
@@ -947,13 +962,13 @@ magic_setnkeys(SV *sv, MAGIC *mg)
/* caller is responsible for stack switching/cleanup */
STATIC int
-magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val)
+magic_methcall(SV *sv, MAGIC *mg, char *meth, I32 flags, int n, SV *val)
{
dSP;
PUSHMARK(SP);
EXTEND(SP, n);
- PUSHs(mg->mg_obj);
+ PUSHs(SvTIED_obj(sv, mg));
if (n > 1) {
if (mg->mg_ptr) {
if (mg->mg_len >= 0)
@@ -982,7 +997,7 @@ magic_methpack(SV *sv, MAGIC *mg, char *meth)
SAVETMPS;
PUSHSTACKi(PERLSI_MAGIC);
- if (magic_methcall(mg, meth, G_SCALAR, 2, NULL)) {
+ if (magic_methcall(sv, mg, meth, G_SCALAR, 2, NULL)) {
sv_setsv(sv, *PL_stack_sp--);
}
@@ -1007,7 +1022,7 @@ magic_setpack(SV *sv, MAGIC *mg)
dSP;
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
- magic_methcall(mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
+ magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
POPSTACK;
LEAVE;
return 0;
@@ -1029,7 +1044,7 @@ magic_sizepack(SV *sv, MAGIC *mg)
ENTER;
SAVETMPS;
PUSHSTACKi(PERLSI_MAGIC);
- if (magic_methcall(mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
+ if (magic_methcall(sv, mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
sv = *PL_stack_sp--;
retval = (U32) SvIV(sv)-1;
}
@@ -1046,7 +1061,7 @@ int magic_wipepack(SV *sv, MAGIC *mg)
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
- XPUSHs(mg->mg_obj);
+ XPUSHs(SvTIED_obj(sv, mg));
PUTBACK;
perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
POPSTACK;
@@ -1065,7 +1080,7 @@ magic_nextpack(SV *sv, MAGIC *mg, SV *key)
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP, 2);
- PUSHs(mg->mg_obj);
+ PUSHs(SvTIED_obj(sv, mg));
if (SvOK(key))
PUSHs(key);
PUTBACK;
@@ -1093,11 +1108,12 @@ magic_setdbline(SV *sv, MAGIC *mg)
I32 i;
GV* gv;
SV** svp;
+ STRLEN n_a;
gv = PL_DBline;
i = SvTRUE(sv);
svp = av_fetch(GvAV(gv),
- atoi(MgPV(mg,PL_na)), FALSE);
+ atoi(MgPV(mg,n_a)), FALSE);
if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
o->op_private = i;
else
@@ -1193,10 +1209,11 @@ magic_setglob(SV *sv, MAGIC *mg)
{
register char *s;
GV* gv;
+ STRLEN n_a;
if (!SvOK(sv))
return 0;
- s = SvPV(sv, PL_na);
+ s = SvPV(sv, n_a);
if (*s == '*' && s[1])
s++;
gv = gv_fetchpv(s,TRUE, SVt_PVGV);
@@ -1406,8 +1423,10 @@ vivify_defelem(SV *sv)
if (svp)
value = *svp;
}
- if (!value || value == &PL_sv_undef)
- croak(no_helem, SvPV(mg->mg_obj, PL_na));
+ if (!value || value == &PL_sv_undef) {
+ STRLEN n_a;
+ croak(no_helem, SvPV(mg->mg_obj, n_a));
+ }
}
else {
AV* av = (AV*)LvTARG(sv);
@@ -1498,6 +1517,9 @@ magic_set(SV *sv, MAGIC *mg)
case '\001': /* ^A */
sv_setsv(PL_bodytarget, sv);
break;
+ case '\003': /* ^C */
+ PL_minus_c = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ break;
case '\004': /* ^D */
PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
DEBUG_x(dump_all());
@@ -1524,7 +1546,7 @@ magic_set(SV *sv, MAGIC *mg)
if (PL_inplace)
Safefree(PL_inplace);
if (SvOK(sv))
- PL_inplace = savepv(SvPV(sv,PL_na));
+ PL_inplace = savepv(SvPV(sv,len));
else
PL_inplace = Nullch;
break;
@@ -1532,7 +1554,7 @@ magic_set(SV *sv, MAGIC *mg)
if (PL_osname)
Safefree(PL_osname);
if (SvOK(sv))
- PL_osname = savepv(SvPV(sv,PL_na));
+ PL_osname = savepv(SvPV(sv,len));
else
PL_osname = Nullch;
break;
@@ -1559,12 +1581,12 @@ magic_set(SV *sv, MAGIC *mg)
break;
case '^':
Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
- IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na));
+ IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
break;
case '~':
Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
- IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na));
+ IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
break;
case '=':
@@ -1621,7 +1643,7 @@ magic_set(SV *sv, MAGIC *mg)
case '#':
if (PL_ofmt)
Safefree(PL_ofmt);
- PL_ofmt = savepv(SvPV(sv,PL_na));
+ PL_ofmt = savepv(SvPV(sv,len));
break;
case '[':
PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
@@ -1729,7 +1751,7 @@ magic_set(SV *sv, MAGIC *mg)
case ')':
#ifdef HAS_SETGROUPS
{
- char *p = SvPV(sv, PL_na);
+ char *p = SvPV(sv, len);
Groups_t gary[NGROUPS];
SET_NUMERIC_STANDARD();
@@ -1777,7 +1799,7 @@ magic_set(SV *sv, MAGIC *mg)
PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case ':':
- PL_chopset = SvPV_force(sv,PL_na);
+ PL_chopset = SvPV_force(sv,len);
break;
case '0':
if (!PL_origalen) {
@@ -1790,7 +1812,10 @@ magic_set(SV *sv, MAGIC *mg)
|| PL_origargv[i] == s + 2
#endif
)
- s += strlen(++s); /* this one is ok too */
+ {
+ ++s;
+ s += strlen(s); /* this one is ok too */
+ }
else
break;
}
@@ -1803,8 +1828,10 @@ magic_set(SV *sv, MAGIC *mg)
my_setenv("NoNe SuCh", Nullch);
/* force copy of environment */
for (i = 0; PL_origenviron[i]; i++)
- if (PL_origenviron[i] == s + 1)
- s += strlen(++s);
+ if (PL_origenviron[i] == s + 1) {
+ ++s;
+ s += strlen(s);
+ }
else
break;
}
@@ -1851,7 +1878,6 @@ magic_mutexfree(SV *sv, MAGIC *mg)
croak("panic: magic_mutexfree");
MUTEX_DESTROY(MgMUTEXP(mg));
COND_DESTROY(MgCONDP(mg));
- SvREFCNT_dec(sv);
return 0;
}
#endif /* USE_THREADS */
OpenPOWER on IntegriCloud