This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
numeric.c: Fix typo, clarify comment
[perl5.git] / perl.c
diff --git a/perl.c b/perl.c
index fea53c0..ae4390e 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -737,10 +737,10 @@ perl_destruct(pTHXx)
     /* We must account for everything.  */
 
     /* Destroy the main CV and syntax tree */
-    /* Do this now, because destroying ops can cause new SVs to be generated
-       in Perl_pad_swipe, and when running with -DDEBUG_LEAKING_SCALARS they
-       PL_curcop to point to a valid op from which the filename structure
-       member is copied.  */
+    /* Set PL_curcop now, because destroying ops can cause new SVs
+       to be generated in Perl_pad_swipe, and when running with
+      -DDEBUG_LEAKING_SCALARS they expect PL_curcop to point to a valid
+       op from which the filename structure member is copied.  */
     PL_curcop = &PL_compiling;
     if (PL_main_root) {
        /* ensure comppad/curpad to refer to main's pad */
@@ -829,7 +829,6 @@ perl_destruct(pTHXx)
 #endif
 
        CopFILE_free(&PL_compiling);
-       CopSTASH_free(&PL_compiling);
 
        /* The exit() function will do everything that needs doing. */
         return STATUS_EXIT;
@@ -841,12 +840,19 @@ perl_destruct(pTHXx)
      * REGEXPs in the parent interpreter
      * we need to manually ReREFCNT_dec for the clones
      */
-    SvREFCNT_dec(PL_regex_padav);
-    PL_regex_padav = NULL;
-    PL_regex_pad = NULL;
+    {
+       I32 i = AvFILLp(PL_regex_padav);
+       SV **ary = AvARRAY(PL_regex_padav);
+
+       for (; i; i--) {
+           SvREFCNT_dec(ary[i]);
+           ary[i] = &PL_sv_undef;
+       }
+    }
     Safefree(PL_stashpad);
 #endif
 
+
     SvREFCNT_dec(MUTABLE_SV(PL_stashcache));
     PL_stashcache = NULL;
 
@@ -1026,7 +1032,6 @@ perl_destruct(pTHXx)
     cophh_free(CopHINTHASH_get(&PL_compiling));
     CopHINTHASH_set(&PL_compiling, cophh_new_empty());
     CopFILE_free(&PL_compiling);
-    CopSTASH_free(&PL_compiling);
 
     /* Prepare to destruct main symbol table.  */
 
@@ -1062,6 +1067,12 @@ perl_destruct(pTHXx)
                             (long)cxstack_ix + 1);
     }
 
+#ifdef USE_ITHREADS
+    SvREFCNT_dec(PL_regex_padav);
+    PL_regex_padav = NULL;
+    PL_regex_pad = NULL;
+#endif
+
 #ifdef PERL_IMPLICIT_CONTEXT
     /* the entries in this list are allocated via SV PVX's, so get freed
      * in sv_clean_all */
@@ -1225,9 +1236,6 @@ perl_destruct(pTHXx)
 
     Safefree(PL_origfilename);
     PL_origfilename = NULL;
-    Safefree(PL_reg_start_tmp);
-    PL_reg_start_tmp = (char**)NULL;
-    PL_reg_start_tmpl = 0;
     Safefree(PL_reg_curpm);
     Safefree(PL_reg_poscache);
     free_tied_hv_pool();
@@ -2404,7 +2412,7 @@ S_run_body(pTHX_ I32 oldscope)
        CALLRUNOPS(aTHX);
     }
     my_exit(0);
-    /* NOTREACHED */
+    assert(0); /* NOTREACHED */
 }
 
 /*
@@ -2512,17 +2520,14 @@ CV*
 Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags)
 {
     GV* const gv = gv_fetchpvn_flags(name, len, flags, SVt_PVCV);
-    /* XXX this is probably not what they think they're getting.
-     * It has the same effect as "sub name;", i.e. just a forward
-     * declaration! */
 
     PERL_ARGS_ASSERT_GET_CVN_FLAGS;
 
+    /* XXX this is probably not what they think they're getting.
+     * It has the same effect as "sub name;", i.e. just a forward
+     * declaration! */
     if ((flags & ~GV_NOADD_MASK) && !GvCVu(gv)) {
-       SV *const sv = newSVpvn_flags(name, len, flags & SVf_UTF8);
-       return newSUB(start_subparse(FALSE, 0),
-                     newSVOP(OP_CONST, 0, sv),
-                     NULL, NULL);
+       return newSTUB(gv,0);
     }
     if (gv)
        return GvCVu(gv);
@@ -2719,7 +2724,7 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
            FREETMPS;
            JMPENV_POP;
            my_exit_jump();
-           /* NOTREACHED */
+           assert(0); /* NOTREACHED */
        case 3:
            if (PL_restartop) {
                PL_restartjmpenv = NULL;
@@ -2797,6 +2802,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     myop.op_flags |= OP_GIMME_REVERSE(flags);
     if (flags & G_KEEPERR)
        myop.op_flags |= OPf_SPECIAL;
+    if (PL_reg_state.re_reparsing)
+       myop.op_private = OPpEVAL_COPHH;
 
     /* fail now; otherwise we could fail after the JMPENV_PUSH but
      * before a PUSHEVAL, which corrupts the stack after a croak */
@@ -2826,7 +2833,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
        FREETMPS;
        JMPENV_POP;
        my_exit_jump();
-       /* NOTREACHED */
+       assert(0); /* NOTREACHED */
     case 3:
        if (PL_restartop) {
            PL_restartjmpenv = NULL;
@@ -4822,7 +4829,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
            CopLINE_set(PL_curcop, oldline);
            JMPENV_POP;
            my_exit_jump();
-           /* NOTREACHED */
+           assert(0); /* NOTREACHED */
        case 3:
            if (PL_restartop) {
                PL_curcop = &PL_compiling;