blead@25775 Symbian update

[p5sagit/p5-mst-13.2.git] / mg.c

diff --git a/mg.c b/mg.c
index f4f8f60..46b2d75 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -785,11 +785,16 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        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 */
@@ -1045,10 +1050,13 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
        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,'<'))) ) {
@@ -2069,7 +2077,7 @@ Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
                } else {
                    Perl_croak(aTHX_
                               "panic: magic_killbackrefs (flags=%"UVxf")",
-                              SvFLAGS(referrer));
+                              (UV)SvFLAGS(referrer));
                }
 
                *svp = Nullsv;
@@ -2621,7 +2629,11 @@ Perl_whichsig(pTHX_ const char *sig)
 }
 
 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);
@@ -2708,12 +2720,14 @@ Perl_sighandler(int sig, ...)
                    * 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, "status",  6, newSViv(sip->si_status), 0);
                   hv_store(sih, "band",    4, newSViv(sip->si_band),   0);
+#endif
                   EXTEND(SP, 2);
                   PUSHs((SV*)rv);
                   PUSHs(newSVpv((void*)sip, sizeof(*sip)));
@@ -2743,7 +2757,7 @@ Perl_sighandler(int sig, ...)
        (void)rsignal(sig, PL_csighandlerp);
 #endif
 #endif /* !PERL_MICRO */
-       DieNull;
+       Perl_die(aTHX_ Nullch);
     }
 cleanup:
     if (flags & 1)
@@ -2784,8 +2798,16 @@ S_restore_magic(pTHX_ const void *p)
            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 */