autodoc.pl: Extract code into a function

[perl5.git] / mg.c

diff --git a/mg.c b/mg.c
index 81c654b..16b72bf 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -41,6 +41,7 @@ tie.
 #include "EXTERN.h"
 #define PERL_IN_MG_C
 #include "perl.h"
+#include "feature.h"
 
 #if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
 #  ifdef I_GRP
@@ -62,13 +63,6 @@ tie.
 #  include <sys/prctl.h>
 #endif
 
-
-#ifdef PERL_USE_3ARG_SIGHANDLER
-Signal_t Perl_csighandler(int sig, Siginfo_t *, void *);
-#else
-Signal_t Perl_csighandler(int sig);
-#endif
-
 #ifdef __Lynx__
 /* Missing protos on LynxOS */
 void setruid(uid_t id);
@@ -1036,9 +1030,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
         if (nextchar == '\0') {
             sv_setiv(sv, (IV)PL_maxsysfd);
         }
-        else if (strEQ(remaining, "EATURE_BITS")) {
-            sv_setuv(sv, PL_compiling.cop_features);
-        }
        break;
     case '\007':               /* ^GLOBAL_PHASE */
        if (strEQ(remaining, "LOBAL_PHASE")) {
@@ -1676,7 +1667,6 @@ Perl_despatch_signals(pTHX)
 int
 Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 {
-    dVAR;
     I32 i;
     SV** svp = NULL;
     /* Need to be careful with SvREFCNT_dec(), because that can have side
@@ -1762,7 +1752,8 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
               Ideally we'd find some way of making SVs at (C) compile time, or
               at least, doing most of the work.  */
            if (!PL_psig_name[i]) {
-               PL_psig_name[i] = newSVpvn(s, len);
+               const char* name = PL_sig_name[i];
+               PL_psig_name[i] = newSVpvn(name, strlen(name));
                SvREADONLY_on(PL_psig_name[i]);
            }
        } else {
@@ -2730,7 +2721,6 @@ S_set_dollarzero(pTHX_ SV *sv)
     PERL_TSA_REQUIRES(PL_dollarzero_mutex)
 {
 #ifdef USE_ITHREADS
-    dVAR;
 #endif
     const char *s;
     STRLEN len;
@@ -2809,7 +2799,6 @@ int
 Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 {
 #ifdef USE_ITHREADS
-    dVAR;
 #endif
     I32 paren;
     const REGEXP * rx;
@@ -2893,9 +2882,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
         if (mg->mg_ptr[1] == '\0') {
             PL_maxsysfd = SvIV(sv);
         }
-        else if (strEQ(mg->mg_ptr + 1, "EATURE_BITS")) {
-            PL_compiling.cop_features = SvUV(sv);
-        }
        break;
     case '\010':       /* ^H */
         {
@@ -2977,9 +2963,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        else if (strEQ(mg->mg_ptr+1, "ARNING_BITS")) {
            if ( ! (PL_dowarn & G_WARN_ALL_MASK)) {
                if (!SvPOK(sv)) {
-                    if (!specialWARN(PL_compiling.cop_warnings))
-                        PerlMemShared_free(PL_compiling.cop_warnings);
-                   PL_compiling.cop_warnings = pWARN_STD;
+            free_and_set_cop_warnings(&PL_compiling, pWARN_STD);
                    break;
                }
                {
@@ -2991,26 +2975,22 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
                        not_all |= ptr[i] ^ 0x55;
                    }
                    if (!not_none) {
-                       if (!specialWARN(PL_compiling.cop_warnings))
-                           PerlMemShared_free(PL_compiling.cop_warnings);
-                       PL_compiling.cop_warnings = pWARN_NONE;
+                free_and_set_cop_warnings(&PL_compiling, pWARN_NONE);
                    } else if (len >= WARNsize && !not_all) {
-                       if (!specialWARN(PL_compiling.cop_warnings))
-                           PerlMemShared_free(PL_compiling.cop_warnings);
-                       PL_compiling.cop_warnings = pWARN_ALL;
-                       PL_dowarn |= G_WARN_ONCE ;
-                   }
-                    else {
-                       STRLEN len;
-                       const char *const p = SvPV_const(sv, len);
-
-                       PL_compiling.cop_warnings
-                           = Perl_new_warnings_bitfield(aTHX_ PL_compiling.cop_warnings,
+                free_and_set_cop_warnings(&PL_compiling, pWARN_ALL);
+                   PL_dowarn |= G_WARN_ONCE ;
+               }
+            else {
+                            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))
+                    if (isWARN_on(PL_compiling.cop_warnings, WARN_ONCE))
                            PL_dowarn |= G_WARN_ONCE ;
-                   }
+              }
 
                }
            }
@@ -3687,6 +3667,7 @@ Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
     PL_hints |= HINT_LOCALIZE_HH;
     CopHINTHASH_set(&PL_compiling,
        cophh_store_sv(CopHINTHASH_get(&PL_compiling), key, 0, sv, 0));
+    magic_sethint_feature(key, NULL, 0, sv, 0);
     return 0;
 }
 
@@ -3711,6 +3692,10 @@ Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg)
                                 MUTABLE_SV(mg->mg_ptr), 0, 0)
         : cophh_delete_pvn(CopHINTHASH_get(&PL_compiling),
                                 mg->mg_ptr, mg->mg_len, 0, 0));
+    if (mg->mg_len == HEf_SVKEY)
+        magic_sethint_feature(MUTABLE_SV(mg->mg_ptr), NULL, 0, NULL, FALSE);
+    else
+        magic_sethint_feature(NULL, mg->mg_ptr, mg->mg_len, NULL, FALSE);
     return 0;
 }
 
@@ -3729,6 +3714,7 @@ Perl_magic_clearhints(pTHX_ SV *sv, MAGIC *mg)
     PERL_UNUSED_ARG(mg);
     cophh_free(CopHINTHASH_get(&PL_compiling));
     CopHINTHASH_set(&PL_compiling, cophh_new_empty());
+    CLEARFEATUREBITS();
     return 0;
 }