[perl #77240] Don’t warn for --subname

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index 65b0a1c..f9283db 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -522,13 +522,18 @@ perl_destruct(pTHXx)
     PERL_WAIT_FOR_CHILDREN;
 
     destruct_level = PL_perl_destruct_level;
-#ifdef DEBUGGING
+#if defined(DEBUGGING) || defined(PERL_TRACK_MEMPOOL)
     {
        const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
        if (s) {
-            const int i = atoi(s);
-           if (destruct_level < i)
-               destruct_level = i;
+        const int i = atoi(s);
+#ifdef DEBUGGING
+           if (destruct_level < i) destruct_level = i;
+#endif
+#ifdef PERL_TRACK_MEMPOOL
+        /* RT #114496, for perl_free */
+        PL_perl_destruct_level = i;
+#endif
        }
     }
 #endif
@@ -855,7 +860,7 @@ perl_destruct(pTHXx)
     PL_minus_F      = FALSE;
     PL_doswitches   = FALSE;
     PL_dowarn       = G_WARN_OFF;
-    PL_sawampersand = FALSE;   /* must save all match strings */
+    PL_sawampersand = 0;       /* must save all match strings */
     PL_unsafe       = FALSE;
 
     Safefree(PL_inplace);
@@ -1143,7 +1148,7 @@ perl_destruct(pTHXx)
     if (PL_sv_count != 0) {
        SV* sva;
        SV* sv;
-       register SV* svend;
+       SV* svend;
 
        for (sva = PL_sv_arenaroot; sva; sva = MUTABLE_SV(SvANY(sva))) {
            svend = &sva[SvREFCNT(sva)];
@@ -1224,7 +1229,6 @@ perl_destruct(pTHXx)
        PL_psig_pend = (int*)NULL;
        Safefree(psig_save);
     }
-    PL_formfeed = NULL;
     nuke_stacks();
     PL_tainting = FALSE;
     PL_taint_warn = FALSE;
@@ -1294,8 +1298,7 @@ perl_free(pTHXx)
         * Don't free thread memory if PERL_DESTRUCT_LEVEL is set to a non-zero
         * value as we're probably hunting memory leaks then
         */
-       const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
-       if (!s || atoi(s) == 0) {
+       if (PL_perl_destruct_level == 0) {
            const U32 old_debug = PL_debug;
            /* Emulate the PerlHost behaviour of free()ing all memory allocated in this
               thread at thread exit.  */
@@ -1777,7 +1780,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     char **argv = PL_origargv;
     const char *scriptname = NULL;
     VOL bool dosearch = FALSE;
-    register char c;
+    char c;
     bool doextract = FALSE;
     const char *cddir = NULL;
 #ifdef USE_SITECUSTOMIZE
@@ -2339,8 +2342,9 @@ STATIC void
 S_run_body(pTHX_ I32 oldscope)
 {
     dVAR;
-    DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
-                    PL_sawampersand ? "Enabling" : "Omitting"));
+    DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support (0x%x).\n",
+                    PL_sawampersand ? "Enabling" : "Omitting",
+                    (unsigned int)(PL_sawampersand)));
 
     if (!PL_restartop) {
 #ifdef PERL_MAD
@@ -2637,7 +2641,6 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
     }
 
     Zero(&myop, 1, LOGOP);
-    myop.op_next = NULL;
     if (!(flags & G_NOARGS))
        myop.op_flags |= OPf_STACKED;
     myop.op_flags |= OP_GIMME_REVERSE(flags);
@@ -2656,11 +2659,11 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
            * curstash may be meaningless. */
          && (SvTYPE(sv) != SVt_PVCV || CvSTASH((const CV *)sv) != PL_debstash)
          && !(flags & G_NODEBUG))
-       PL_op->op_private |= OPpENTERSUB_DB;
+       myop.op_private |= OPpENTERSUB_DB;
 
     if (flags & G_METHOD) {
        Zero(&method_op, 1, UNOP);
-       method_op.op_next = PL_op;
+       method_op.op_next = (OP*)&myop;
        method_op.op_ppaddr = PL_ppaddr[OP_METHOD];
        method_op.op_type = OP_METHOD;
        myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
@@ -2767,13 +2770,12 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 
     SAVEOP();
     PL_op = (OP*)&myop;
-    Zero(PL_op, 1, UNOP);
+    Zero(&myop, 1, UNOP);
     EXTEND(PL_stack_sp, 1);
     *++PL_stack_sp = sv;
 
     if (!(flags & G_NOARGS))
        myop.op_flags = OPf_STACKED;
-    myop.op_next = NULL;
     myop.op_type = OP_ENTEREVAL;
     myop.op_flags |= OP_GIMME_REVERSE(flags);
     if (flags & G_KEEPERR)
@@ -3437,10 +3439,6 @@ S_minus_v(pTHX)
        PerlIO_printf(PerlIO_stdout(),
                      "BeOS port Copyright Tom Spindler, 1997-1999\n");
 #endif
-#ifdef MPE
-       PerlIO_printf(PerlIO_stdout(),
-                     "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2003\n");
-#endif
 #ifdef OEMVS
        PerlIO_printf(PerlIO_stdout(),
                      "MVS (OS390) port by Mortice Kern Systems, 1997-1999\n");
@@ -3449,10 +3447,6 @@ S_minus_v(pTHX)
        PerlIO_printf(PerlIO_stdout(),
                      "Stratus VOS port by Paul.Green@stratus.com, 1997-2002\n");
 #endif
-#ifdef __OPEN_VM
-       PerlIO_printf(PerlIO_stdout(),
-                     "VM/ESA port by Neale Ferguson, 1998-1999\n");
-#endif
 #ifdef POSIX_BC
        PerlIO_printf(PerlIO_stdout(),
                      "BS2000 (POSIX) port by Start Amadeus GmbH, 1998-1999\n");
@@ -3765,7 +3759,7 @@ S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
 {
     dVAR;
     const char *s;
-    register const char *s2;
+    const char *s2;
 
     PERL_ARGS_ASSERT_FIND_BEGINNING;