Changes to perlfaq8 "How do I find out if I'm running interactively

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

diff --git a/mg.c b/mg.c
index 268e067..d7105b5 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -826,7 +826,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                }
            }
             else {
-               sv_setsv(sv, PL_compiling.cop_warnings);
+               sv_setpvn(sv, (char *) (PL_compiling.cop_warnings + 1),
+                         *PL_compiling.cop_warnings);
            }
            SvPOK_only(sv);
        }
@@ -1042,8 +1043,8 @@ int
 Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
-    STRLEN len, klen;
-    const char *s = SvPV_const(sv,len);
+    STRLEN len = 0, klen;
+    const char *s = SvOK(sv) ? SvPV_const(sv,len) : "";
     const char * const ptr = MgPV_const(mg,klen);
     my_setenv(ptr, s);
 
@@ -1053,7 +1054,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
     if (!len) {
        SV ** const valp = hv_fetch(GvHVn(PL_envgv), ptr, klen, FALSE);
        if (valp)
-           s = SvPV_const(*valp, len);
+           s = SvOK(*valp) ? SvPV_const(*valp, len) : "";
     }
 #endif
 
@@ -1773,11 +1774,12 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     SV* const lsv = LvTARG(sv);
+    PERL_UNUSED_ARG(mg);
 
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
-       mg = mg_find(lsv, PERL_MAGIC_regex_global);
-       if (mg && mg->mg_len >= 0) {
-           I32 i = mg->mg_len;
+       MAGIC * const found = mg_find(lsv, PERL_MAGIC_regex_global);
+       if (found && found->mg_len >= 0) {
+           I32 i = found->mg_len;
            if (DO_UTF8(lsv))
                sv_pos_b2u(lsv, &i);
            sv_setiv(sv, i + CopARYBASE_get(PL_curcop));
@@ -1796,23 +1798,26 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
     SSize_t pos;
     STRLEN len;
     STRLEN ulen = 0;
+    MAGIC *found;
 
-    mg = 0;
+    PERL_UNUSED_ARG(mg);
 
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
-       mg = mg_find(lsv, PERL_MAGIC_regex_global);
-    if (!mg) {
+       found = mg_find(lsv, PERL_MAGIC_regex_global);
+    else
+       found = NULL;
+    if (!found) {
        if (!SvOK(sv))
            return 0;
 #ifdef PERL_OLD_COPY_ON_WRITE
     if (SvIsCOW(lsv))
         sv_force_normal_flags(lsv, 0);
 #endif
-       mg = sv_magicext(lsv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
+       found = sv_magicext(lsv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
                         NULL, 0);
     }
     else if (!SvOK(sv)) {
-       mg->mg_len = -1;
+       found->mg_len = -1;
        return 0;
     }
     len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
@@ -1839,8 +1844,8 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
        pos = p;
     }
 
-    mg->mg_len = pos;
-    mg->mg_flags &= ~MGf_MINMATCH;
+    found->mg_len = pos;
+    found->mg_flags &= ~MGf_MINMATCH;
 
     return 0;
 }
@@ -2140,7 +2145,7 @@ Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
     PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(sv);
     Safefree(mg->mg_ptr);      /* The mg_ptr holds the pos cache. */
-    mg->mg_ptr = 0;
+    mg->mg_ptr = NULL;
     mg->mg_len = -1;           /* The mg_len holds the len cache. */
     return 0;
 }
@@ -2270,15 +2275,20 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
                    }
                    if (!accumulate)
                        PL_compiling.cop_warnings = pWARN_NONE;
-                   else if (isWARN_on(sv, WARN_ALL) && !any_fatals) {
+                   /* Yuck. I can't see how to abstract this:  */
+                   else if (isWARN_on(((STRLEN *)SvPV_nolen_const(sv)) - 1,
+                                      WARN_ALL) && !any_fatals) {
                        PL_compiling.cop_warnings = pWARN_ALL;
                        PL_dowarn |= G_WARN_ONCE ;
                    }
                     else {
-                       if (specialWARN(PL_compiling.cop_warnings))
-                           PL_compiling.cop_warnings = newSVsv(sv) ;
-                       else
-                           sv_setsv(PL_compiling.cop_warnings, sv);
+                       STRLEN len;
+                       const char *const p = SvPV_const(sv, len);
+
+                       PL_compiling.cop_warnings
+                           = Perl_new_warnings_bitfield(aTHX_ PL_compiling.cop_warnings,
+                                                        p, len);
+
                        if (isWARN_on(PL_compiling.cop_warnings, WARN_ONCE))
                            PL_dowarn |= G_WARN_ONCE ;
                    }