if (SvTYPE(sv) == SVTYPEMASK) {
Perl_croak(aTHX_ "Tied variable freed while still in use");
}
+ /* guard against magic having been deleted - eg FETCH calling
+ * untie */
+ if (!SvMAGIC(sv))
+ break;
/* Don't restore the flags for this entry if it was deleted. */
if (mg->mg_flags & MGf_GSKIP)
Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
{
register I32 paren;
- register char *s;
+ register char *s = NULL;
register I32 i;
register REGEXP *rx;
}
break;
case '^':
- s = IoTOP_NAME(GvIOp(PL_defoutgv));
+ if (GvIOp(PL_defoutgv))
+ s = IoTOP_NAME(GvIOp(PL_defoutgv));
if (s)
sv_setpv(sv,s);
else {
}
break;
case '~':
- s = IoFMT_NAME(GvIOp(PL_defoutgv));
+ if (GvIOp(PL_defoutgv))
+ s = IoFMT_NAME(GvIOp(PL_defoutgv));
if (!s)
s = GvENAME(PL_defoutgv);
sv_setpv(sv,s);
break;
#ifndef lint
case '=':
- sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(PL_defoutgv)));
+ if (GvIOp(PL_defoutgv))
+ sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(PL_defoutgv)));
break;
case '-':
- sv_setiv(sv, (IV)IoLINES_LEFT(GvIOp(PL_defoutgv)));
+ if (GvIOp(PL_defoutgv))
+ sv_setiv(sv, (IV)IoLINES_LEFT(GvIOp(PL_defoutgv)));
break;
case '%':
- sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv)));
+ if (GvIOp(PL_defoutgv))
+ sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv)));
break;
#endif
case ':':
WITH_THR(sv_setiv(sv, (IV)PL_curcop->cop_arybase));
break;
case '|':
- sv_setiv(sv, (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0 );
+ if (GvIOp(PL_defoutgv))
+ sv_setiv(sv, (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0 );
break;
case ',':
break;
int
Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
{
+#ifndef PERL_MICRO
#if defined(VMS) || defined(EPOC)
Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
#else
}
# endif /* USE_ENVIRON_ARRAY */
# endif /* PERL_IMPLICIT_SYS || WIN32 */
-#endif /* VMS || EPC */
+#endif /* VMS || EPOC */
+#endif /* !PERL_MICRO */
return 0;
}
#endif
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
sig_defaulting[i] = 1;
- (void)rsignal(i, &Perl_csighandler);
+ (void)rsignal(i, PL_csighandlerp);
#else
(void)rsignal(i, SIG_DFL);
#endif
dTHX;
#endif
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
- (void) rsignal(sig, &Perl_csighandler);
+ (void) rsignal(sig, PL_csighandlerp);
if (sig_ignoring[sig]) return;
#endif
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
dTHX;
sig_defaulting[sig] = 1;
- (void) rsignal(sig, &Perl_csighandler);
+ (void) rsignal(sig, PL_csighandlerp);
#endif
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
sig_ignoring[sig] = 0;
}
if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
if (i) {
- (void)rsignal(i, &Perl_csighandler);
+ (void)rsignal(i, PL_csighandlerp);
#ifdef HAS_SIGPROCMASK
LEAVE;
#endif
if (i) {
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
sig_ignoring[i] = 1;
- (void)rsignal(i, &Perl_csighandler);
+ (void)rsignal(i, PL_csighandlerp);
#else
(void)rsignal(i, SIG_IGN);
#endif
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
{
sig_defaulting[i] = 1;
- (void)rsignal(i, &Perl_csighandler);
+ (void)rsignal(i, PL_csighandlerp);
}
#else
(void)rsignal(i, SIG_DFL);
if (!strchr(s,':') && !strchr(s,'\''))
sv_insert(sv, 0, 0, "main::", 6);
if (i)
- (void)rsignal(i, &Perl_csighandler);
+ (void)rsignal(i, PL_csighandlerp);
else
*svp = SvREFCNT_inc(sv);
}
int
Perl_magic_getpack(pTHX_ SV *sv, MAGIC *mg)
{
- magic_methpack(sv,mg,"FETCH");
if (mg->mg_ptr)
mg->mg_flags |= MGf_GSKIP;
+ magic_methpack(sv,mg,"FETCH");
return 0;
}
}
i--;
}
+ SvREFCNT_dec(av); /* remove extra count added by sv_add_backref() */
return 0;
}
pstat(PSTAT_SETCMD, un, len, 0, 0);
}
#endif
- /* PL_origalen is set in perl_parse() to be the sum
- * of the contiguous argv[] elements plus the size of
- * the env in case that is contiguous with the argv[].
- *
- * This means that in the worst case the area we are able
- * to modify is limited to the size of the original argv[0].
- * --jhi */
+ /* PL_origalen is set in perl_parse(). */
s = SvPV_force(sv,len);
- if (len >= (I32)PL_origalen) {
+ if (len >= (STRLEN)PL_origalen) {
/* Longer than original, will be truncated. */
Copy(s, PL_origargv[0], PL_origalen, char);
PL_origargv[0][PL_origalen - 1] = 0;
memset(PL_origargv[0] + len + 1,
/* Is the space counterintuitive? Yes.
* (You were expecting \0?)
- * Does it work? Seems to. (In Linux at least.)
+ * Does it work? Seems to. (In Linux 2.4.20 at least.)
* --jhi */
(int)' ',
PL_origalen - len - 1);
#else
/* Not clear if this will work */
(void)rsignal(sig, SIG_IGN);
- (void)rsignal(sig, &Perl_csighandler);
+ (void)rsignal(sig, PL_csighandlerp);
#endif
#endif /* !PERL_MICRO */
Perl_die(aTHX_ Nullformat);