# 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 */
if (*(mg->mg_ptr+1) == '\0')
sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE));
else if (strEQ(mg->mg_ptr+1, "ARNING_BITS")) {
- if (PL_compiling.cop_warnings == pWARN_NONE ||
- PL_compiling.cop_warnings == pWARN_STD)
- {
+ if (PL_compiling.cop_warnings == pWARN_NONE) {
sv_setpvn(sv, WARN_NONEstring, WARNsize) ;
- }
+ }
+ else if (PL_compiling.cop_warnings == pWARN_STD) {
+ sv_setpvn(
+ sv,
+ (PL_dowarn & G_WARN_ON) ? WARN_ALLstring : WARN_NONEstring,
+ WARNsize
+ );
+ }
else if (PL_compiling.cop_warnings == pWARN_ALL) {
/* Get the bit mask for $warnings::Bits{all}, because
* it could have been extended by warnings::register */
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));
}
} else {
Perl_croak(aTHX_
"panic: magic_killbackrefs (flags=%"UVxf")",
- SvFLAGS(referrer));
+ (UV)SvFLAGS(referrer));
}
*svp = Nullsv;
}
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 */
projects / p5sagit/p5-mst-13.2.git / blobdiff