This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Re: [PATCH] add pTHX_ parameter to new_warnings_bitfield()
[perl5.git] / mg.c
diff --git a/mg.c b/mg.c
index d8f4e0e..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);
        }
@@ -963,7 +964,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '/':
        break;
     case '[':
-       WITH_THR(sv_setiv(sv, (IV)PL_curcop->cop_arybase));
+       WITH_THR(sv_setiv(sv, (IV)CopARYBASE_get(PL_curcop)));
        break;
     case '|':
        if (GvIOp(PL_defoutgv))
@@ -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
 
@@ -1724,7 +1725,7 @@ Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
     dVAR;
     const AV * const obj = (AV*)mg->mg_obj;
     if (obj) {
-       sv_setiv(sv, AvFILL(obj) + PL_curcop->cop_arybase);
+       sv_setiv(sv, AvFILL(obj) + CopARYBASE_get(PL_curcop));
     } else {
        SvOK_off(sv);
     }
@@ -1737,7 +1738,7 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
     dVAR;
     AV * const obj = (AV*)mg->mg_obj;
     if (obj) {
-       av_fill(obj, SvIV(sv) - PL_curcop->cop_arybase);
+       av_fill(obj, SvIV(sv) - CopARYBASE_get(PL_curcop));
     } else {
        if (ckWARN(WARN_MISC))
            Perl_warner(aTHX_ packWARN(WARN_MISC),
@@ -1773,14 +1774,15 @@ 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 + PL_curcop->cop_arybase);
+           sv_setiv(sv, i + CopARYBASE_get(PL_curcop));
            return 0;
        }
     }
@@ -1796,28 +1798,31 @@ 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);
 
-    pos = SvIV(sv) - PL_curcop->cop_arybase;
+    pos = SvIV(sv) - CopARYBASE_get(PL_curcop);
 
     if (DO_UTF8(lsv)) {
        ulen = sv_len_utf8(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;
 }
@@ -2157,7 +2162,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        sv_setsv(PL_bodytarget, sv);
        break;
     case '\003':       /* ^C */
-       PL_minus_c = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+       PL_minus_c = (bool)SvIV(sv);
        break;
 
     case '\004':       /* ^D */
@@ -2166,25 +2171,25 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        PL_debug = get_debug_opts(&s, 0) | DEBUG_TOP_FLAG;
        DEBUG_x(dump_all());
 #else
-       PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;
+       PL_debug = (SvIV(sv)) | DEBUG_TOP_FLAG;
 #endif
        break;
     case '\005':  /* ^E */
        if (*(mg->mg_ptr+1) == '\0') {
 #ifdef MACOS_TRADITIONAL
-           gMacPerl_OSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+           gMacPerl_OSErr = SvIV(sv);
 #else
 #  ifdef VMS
-           set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+           set_vaxc_errno(SvIV(sv));
 #  else
 #    ifdef WIN32
            SetLastError( SvIV(sv) );
 #    else
 #      ifdef OS2
-           os2_setsyserrno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+           os2_setsyserrno(SvIV(sv));
 #      else
            /* will anyone ever use this? */
-           SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
+           SETERRNO(SvIV(sv), 4);
 #      endif
 #    endif
 #  endif
@@ -2202,10 +2207,10 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        }
        break;
     case '\006':       /* ^F */
-       PL_maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+       PL_maxsysfd = SvIV(sv);
        break;
     case '\010':       /* ^H */
-       PL_hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+       PL_hints = SvIV(sv);
        break;
     case '\011':       /* ^I */ /* NOT \t in EBCDIC */
        Safefree(PL_inplace);
@@ -2228,7 +2233,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        }
        break;
     case '\020':       /* ^P */
-       PL_perldb = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+       PL_perldb = SvIV(sv);
        if (PL_perldb && !PL_DBsingle)
            init_debugger();
        break;
@@ -2236,7 +2241,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #ifdef BIG_TIME
        PL_basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
 #else
-       PL_basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+       PL_basetime = (Time_t)SvIV(sv);
 #endif
        break;
     case '\025':       /* ^UTF8CACHE */
@@ -2247,7 +2252,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     case '\027':       /* ^W & $^WARNING_BITS */
        if (*(mg->mg_ptr+1) == '\0') {
            if ( ! (PL_dowarn & G_WARN_ALL_MASK)) {
-               i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+               i = SvIV(sv);
                PL_dowarn = (PL_dowarn & ~G_WARN_ON)
                                | (i ? G_WARN_ON : G_WARN_OFF) ;
            }
@@ -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 ;
                    }
@@ -2306,22 +2316,22 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        IoFMT_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
        break;
     case '=':
-       IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+       IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv));
        break;
     case '-':
-       IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+       IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv));
        if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L)
            IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L;
        break;
     case '%':
-       IoPAGE(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+       IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv));
        break;
     case '|':
        {
            IO * const io = GvIOp(PL_defoutgv);
            if(!io)
              break;
-           if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) == 0)
+           if ((SvIV(sv)) == 0)
                IoFLAGS(io) &= ~IOf_FLUSH;
            else {
                if (!(IoFLAGS(io) & IOf_FLUSH)) {
@@ -2358,7 +2368,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        }
        break;
     case '[':
-       PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+       CopARYBASE_set(&PL_compiling, SvIV(sv));
        break;
     case '?':
 #ifdef COMPLEX_STATUS
@@ -2373,7 +2383,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            STATUS_NATIVE_CHILD_SET((U32)SvIV(sv));
        else
 #endif
-           STATUS_UNIX_EXIT_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+           STATUS_UNIX_EXIT_SET(SvIV(sv));
        break;
     case '!':
         {
@@ -2387,7 +2397,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        }
        break;
     case '<':
-       PL_uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+       PL_uid = SvIV(sv);
        if (PL_delaymagic) {
            PL_delaymagic |= DM_RUID;
            break;                              /* don't do magic till later */
@@ -2419,7 +2429,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
        break;
     case '>':
-       PL_euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+       PL_euid = SvIV(sv);
        if (PL_delaymagic) {
            PL_delaymagic |= DM_EUID;
            break;                              /* don't do magic till later */
@@ -2446,7 +2456,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
        break;
     case '(':
-       PL_gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+       PL_gid = SvIV(sv);
        if (PL_delaymagic) {
            PL_delaymagic |= DM_RGID;
            break;                              /* don't do magic till later */
@@ -2500,7 +2510,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
                 Safefree(gary);
        }
 #else  /* HAS_SETGROUPS */
-       PL_egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+       PL_egid = SvIV(sv);
 #endif /* HAS_SETGROUPS */
        if (PL_delaymagic) {
            PL_delaymagic |= DM_EGID;
Unnamed repository; edit this file 'description' to name the repository.