# include <sys/pstat.h>
#endif
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+Signal_t Perl_csighandler(int sig, ...);
+#else
Signal_t Perl_csighandler(int sig);
+#endif
#ifdef __Lynx__
/* Missing protos on LynxOS */
MgTAINTEDDIR_off(mg);
#ifdef VMS
if (s && klen == 8 && strEQ(ptr, "DCL$PATH")) {
- char pathbuf[256], eltbuf[256], *cp, *elt = s;
+ char pathbuf[256], eltbuf[256], *cp, *elt;
Stat_t sbuf;
int i = 0, j = 0;
+ strncpy(eltbuf, s, 255);
+ eltbuf[255] = 0;
+ elt = eltbuf;
do { /* DCL$PATH may be a search list */
while (1) { /* as may dev portion of any element */
if ( ((cp = strchr(elt,'[')) || (cp = strchr(elt,'<'))) ) {
if (PL_sig_handlers_initted && PL_sig_defaulting[i]) sigstate = SIG_DFL;
#endif
/* cache state so we don't fetch it again */
- if(sigstate == SIG_IGN)
+ if(sigstate == (Sighandler_t) SIG_IGN)
sv_setpv(sv,"IGNORE");
else
sv_setsv(sv,&PL_sv_undef);
PL_sig_defaulting[i] = 1;
(void)rsignal(i, PL_csighandlerp);
#else
- (void)rsignal(i, SIG_DFL);
+ (void)rsignal(i, (Sighandler_t) SIG_DFL);
#endif
if(PL_psig_name[i]) {
SvREFCNT_dec(PL_psig_name[i]);
}
Signal_t
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+Perl_csighandler(int sig, ...)
+#else
Perl_csighandler(int sig)
+#endif
{
#ifdef PERL_GET_SIG_CONTEXT
dTHXa(PERL_GET_SIG_CONTEXT);
PL_sig_ignoring[i] = 1;
(void)rsignal(i, PL_csighandlerp);
#else
- (void)rsignal(i, SIG_IGN);
+ (void)rsignal(i, (Sighandler_t) SIG_IGN);
#endif
}
}
(void)rsignal(i, PL_csighandlerp);
}
#else
- (void)rsignal(i, SIG_DFL);
+ (void)rsignal(i, (Sighandler_t) SIG_DFL);
#endif
}
else {
Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
{
PERL_UNUSED_ARG(sv);
- TAINT_IF(mg->mg_len & 1);
+ TAINT_IF((PL_localizing != 1) && (mg->mg_len & 1));
return 0;
}
Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg)
{
PERL_UNUSED_ARG(sv);
- if (PL_tainted)
- mg->mg_len |= 1;
- else
- mg->mg_len &= ~1;
+ /* update taint status unless we're restoring at scope exit */
+ if (PL_localizing != 2) {
+ if (PL_tainted)
+ mg->mg_len |= 1;
+ else
+ mg->mg_len &= ~1;
+ }
return 0;
}
if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av))
LvTARG(sv) = Nullsv; /* array can't be extended */
else {
- SV** svp = av_fetch(av, LvTARGOFF(sv), TRUE);
+ SV** const svp = av_fetch(av, LvTARGOFF(sv), TRUE);
if (!svp || (value = *svp) == &PL_sv_undef)
Perl_croak(aTHX_ PL_no_aelem, (I32)LvTARGOFF(sv));
}
int
Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
{
- AV * const av = (AV*)mg->mg_obj;
- SV ** const svp = AvARRAY(av);
- I32 i = AvFILLp(av);
+ AV *const av = (AV*)mg->mg_obj;
+ SV **svp = AvARRAY(av);
PERL_UNUSED_ARG(sv);
- while (i >= 0) {
- if (svp[i]) {
- if (!SvWEAKREF(svp[i]))
- Perl_croak(aTHX_ "panic: magic_killbackrefs");
- /* XXX Should we check that it hasn't changed? */
- SvRV_set(svp[i], 0);
- SvOK_off(svp[i]);
- SvWEAKREF_off(svp[i]);
- svp[i] = Nullsv;
+ if (svp) {
+ SV *const *const last = svp + AvFILLp(av);
+
+ while (svp <= last) {
+ if (*svp) {
+ SV *const referrer = *svp;
+ if (SvWEAKREF(referrer)) {
+ /* XXX Should we check that it hasn't changed? */
+ SvRV_set(referrer, 0);
+ SvOK_off(referrer);
+ SvWEAKREF_off(referrer);
+ } else if (SvTYPE(referrer) == SVt_PVGV ||
+ SvTYPE(referrer) == SVt_PVLV) {
+ /* You lookin' at me? */
+ assert(GvSTASH(referrer));
+ assert(GvSTASH(referrer) == (HV*)sv);
+ GvSTASH(referrer) = 0;
+ } else {
+ Perl_croak(aTHX_
+ "panic: magic_killbackrefs (flags=%"UVxf")",
+ (UV)SvFLAGS(referrer));
+ }
+
+ *svp = Nullsv;
+ }
+ svp++;
}
- i--;
}
SvREFCNT_dec(av); /* remove extra count added by sv_add_backref() */
return 0;
PL_hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
break;
case '\011': /* ^I */ /* NOT \t in EBCDIC */
- if (PL_inplace)
- Safefree(PL_inplace);
- if (SvOK(sv))
- PL_inplace = savesvpv(sv);
- else
- PL_inplace = Nullch;
+ Safefree(PL_inplace);
+ PL_inplace = SvOK(sv) ? savesvpv(sv) : Nullch;
break;
case '\017': /* ^O */
if (*(mg->mg_ptr+1) == '\0') {
- if (PL_osname) {
- Safefree(PL_osname);
- PL_osname = Nullch;
- }
+ Safefree(PL_osname);
+ PL_osname = Nullch;
if (SvOK(sv)) {
TAINT_PROPER("assigning to $^O");
PL_osname = savesvpv(sv);
}
Signal_t
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+Perl_sighandler(int sig, ...)
+#else
Perl_sighandler(int sig)
+#endif
{
#ifdef PERL_GET_SIG_CONTEXT
dTHXa(PERL_GET_SIG_CONTEXT);
PUSHSTACKi(PERLSI_SIGNAL);
PUSHMARK(SP);
PUSHs(sv);
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+ {
+ struct sigaction oact;
+
+ if (sigaction(sig, 0, &oact) == 0 && oact.sa_flags & SA_SIGINFO) {
+ siginfo_t *sip;
+ va_list args;
+
+ va_start(args, sig);
+ sip = (siginfo_t*)va_arg(args, siginfo_t*);
+ if (sip) {
+ HV *sih = newHV();
+ SV *rv = newRV_noinc((SV*)sih);
+ /* The siginfo fields signo, code, errno, pid, uid,
+ * addr, status, and band are defined by POSIX/SUSv3. */
+ hv_store(sih, "signo", 5, newSViv(sip->si_signo), 0);
+ hv_store(sih, "code", 4, newSViv(sip->si_code), 0);
+#if 0 /* XXX TODO: Configure scan for the existence of these, but even that does not help if the SA_SIGINFO is not implemented according to the spec. */
+ hv_store(sih, "errno", 5, newSViv(sip->si_errno), 0);
+ hv_store(sih, "status", 6, newSViv(sip->si_status), 0);
+ hv_store(sih, "uid", 3, newSViv(sip->si_uid), 0);
+ hv_store(sih, "pid", 3, newSViv(sip->si_pid), 0);
+ hv_store(sih, "addr", 4, newSVuv(PTR2UV(sip->si_addr)), 0);
+ hv_store(sih, "band", 4, newSViv(sip->si_band), 0);
+#endif
+ EXTEND(SP, 2);
+ PUSHs((SV*)rv);
+ PUSHs(newSVpv((void*)sip, sizeof(*sip)));
+ }
+ }
+ }
+#endif
PUTBACK;
call_sv((SV*)cv, G_DISCARD|G_EVAL);
(void)rsignal(sig, PL_csighandlerp);
#endif
#endif /* !PERL_MICRO */
- DieNull;
+ Perl_die(aTHX_ Nullch);
}
cleanup:
if (flags & 1)
SvFLAGS(sv) |= mgs->mgs_flags;
else
mg_magical(sv);
- if (SvGMAGICAL(sv))
- SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
+ if (SvGMAGICAL(sv)) {
+ /* downgrade public flags to private,
+ and discard any other private flags */
+
+ U32 public = SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK);
+ if (public) {
+ SvFLAGS(sv) &= ~( public | SVp_IOK|SVp_NOK|SVp_POK );
+ SvFLAGS(sv) |= ( public << PRIVSHIFT );
+ }
+ }
}
mgs->mgs_sv = NULL; /* mark the MGS structure as restored */