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
Increase $B::Deparse::VERSION to 1.33
[perl5.git] / perl.c
diff --git a/perl.c b/perl.c
index e84f1d5..cda99ff 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -325,7 +325,6 @@ perl_construct(pTHXx)
     PL_stashcache = newHV();
 
     PL_patchlevel = newSVpvs("v" PERL_VERSION_STRING);
-    PL_apiversion = newSVpvs("v" PERL_API_VERSION_STRING);
 
 #ifdef HAS_MMAP
     if (!PL_mmap_page_size) {
@@ -906,7 +905,6 @@ perl_destruct(pTHXx)
     Safefree(PL_inplace);
     PL_inplace = NULL;
     SvREFCNT_dec(PL_patchlevel);
-    SvREFCNT_dec(PL_apiversion);
 
     if (PL_e_script) {
        SvREFCNT_dec(PL_e_script);
@@ -968,6 +966,9 @@ perl_destruct(pTHXx)
     PL_DBsingle = NULL;
     PL_DBtrace = NULL;
     PL_DBsignal = NULL;
+    PL_DBsingle_iv = 0;
+    PL_DBtrace_iv = 0;
+    PL_DBsignal_iv = 0;
     PL_DBcv = NULL;
     PL_dbargs = NULL;
     PL_debstash = NULL;
@@ -1034,10 +1035,12 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_utf8_foldable);
     SvREFCNT_dec(PL_utf8_foldclosures);
     SvREFCNT_dec(PL_AboveLatin1);
+    SvREFCNT_dec(PL_InBitmap);
     SvREFCNT_dec(PL_UpperLatin1);
     SvREFCNT_dec(PL_Latin1);
     SvREFCNT_dec(PL_NonL1NonFinalFold);
     SvREFCNT_dec(PL_HasMultiCharFold);
+    SvREFCNT_dec(PL_warn_locale);
     PL_utf8_mark       = NULL;
     PL_utf8_toupper    = NULL;
     PL_utf8_totitle    = NULL;
@@ -1047,7 +1050,9 @@ perl_destruct(pTHXx)
     PL_utf8_idcont     = NULL;
     PL_utf8_foldclosures = NULL;
     PL_AboveLatin1       = NULL;
+    PL_InBitmap          = NULL;
     PL_HasMultiCharFold  = NULL;
+    PL_warn_locale       = NULL;
     PL_Latin1            = NULL;
     PL_NonL1NonFinalFold = NULL;
     PL_UpperLatin1       = NULL;
@@ -1287,10 +1292,11 @@ perl_destruct(pTHXx)
     TAINTING_set(FALSE);
     TAINT_WARN_set(FALSE);
     PL_hints = 0;              /* Reset hints. Should hints be per-interpreter ? */
-    PL_debug = 0;
 
     DEBUG_P(debprofdump());
 
+    PL_debug = 0;
+
 #ifdef USE_REENTRANT_API
     Perl_reentrant_free(aTHX);
 #endif
@@ -1361,8 +1367,11 @@ perl_free(pTHXx)
                            "free this thread's memory\n");
                PL_debug &= ~ DEBUG_m_FLAG;
            }
-           while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header))
-               safesysfree(PERL_MEMORY_DEBUG_HEADER_SIZE + (char *)(aTHXx->Imemory_debug_header.next));
+           while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header)){
+               char * next = (char *)(aTHXx->Imemory_debug_header.next);
+               Malloc_t ptr = PERL_MEMORY_DEBUG_HEADER_SIZE + next;
+               safesysfree(ptr);
+           }
            PL_debug = old_debug;
        }
     }
@@ -2070,9 +2079,10 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                it should be reported immediately as a build failure.  */
            (void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
                                                 Perl_newSVpvf(aTHX_
-        "BEGIN { do {local $!; -f q%c%"SVf"/buildcustomize.pl%c} and do q%c%"SVf"/buildcustomize.pl%c || die $@ }",
-                                                              0, SVfARG(*inc0), 0,
-                                                              0, SVfARG(*inc0), 0));
+               "BEGIN { my $f = q%c%s%"SVf"/buildcustomize.pl%c; "
+                       "do {local $!; -f $f }"
+                       " and do $f || die $@ || qq '$f: $!' }",
+                                0, (TAINTING_get ? "./" : ""), SVfARG(*inc0), 0));
        }
 #  else
        /* SITELIB_EXP is a function call on Win32.  */
@@ -2156,7 +2166,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     PL_main_cv = PL_compcv = MUTABLE_CV(newSV_type(SVt_PVCV));
     CvUNIQUE_on(PL_compcv);
 
-    CvPADLIST(PL_compcv) = pad_new(0);
+    CvPADLIST_set(PL_compcv, pad_new(0));
 
     PL_isarev = newHV();
 
@@ -2386,7 +2396,7 @@ S_run_body(pTHX_ I32 oldscope)
            my_exit(0);
        }
        if (PERLDB_SINGLE && PL_DBsingle)
-           sv_setiv(PL_DBsingle, 1);
+            PL_DBsingle_iv = 1;
        if (PL_initav) {
            PERL_SET_PHASE(PERL_PHASE_INIT);
            call_list(oldscope, PL_initav);
@@ -2413,7 +2423,7 @@ S_run_body(pTHX_ I32 oldscope)
        CALLRUNOPS(aTHX);
     }
     my_exit(0);
-    assert(0); /* NOTREACHED */
+    NOT_REACHED; /* NOTREACHED */
 }
 
 /*
@@ -2643,8 +2653,7 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
 {
     dVAR; dSP;
     LOGOP myop;                /* fake syntax tree node */
-    UNOP method_unop;
-    SVOP method_svop;
+    METHOP method_op;
     I32 oldmark;
     VOL I32 retval = 0;
     I32 oldscope;
@@ -2688,23 +2697,19 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
        myop.op_private |= OPpENTERSUB_DB;
 
     if (flags & (G_METHOD|G_METHOD_NAMED)) {
+        Zero(&method_op, 1, METHOP);
+        method_op.op_next = (OP*)&myop;
+        PL_op = (OP*)&method_op;
         if ( flags & G_METHOD_NAMED ) {
-            Zero(&method_svop, 1, SVOP);
-            method_svop.op_next = (OP*)&myop;
-            method_svop.op_ppaddr = PL_ppaddr[OP_METHOD_NAMED];
-            method_svop.op_type = OP_METHOD_NAMED;
-            method_svop.op_sv = sv;
-            PL_op = (OP*)&method_svop;
+            method_op.op_ppaddr = PL_ppaddr[OP_METHOD_NAMED];
+            method_op.op_type = OP_METHOD_NAMED;
+            method_op.op_u.op_meth_sv = sv;
         } else {
-            Zero(&method_unop, 1, UNOP);
-            method_unop.op_next = (OP*)&myop;
-            method_unop.op_ppaddr = PL_ppaddr[OP_METHOD];
-            method_unop.op_type = OP_METHOD;
-            PL_op = (OP*)&method_unop;
+            method_op.op_ppaddr = PL_ppaddr[OP_METHOD];
+            method_op.op_type = OP_METHOD;
         }
         myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
         myop.op_type = OP_ENTERSUB;
-
     }
 
     if (!(flags & G_EVAL)) {
@@ -2739,7 +2744,7 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
            FREETMPS;
            JMPENV_POP;
            my_exit_jump();
-           assert(0); /* NOTREACHED */
+           NOT_REACHED; /* NOTREACHED */
        case 3:
            if (PL_restartop) {
                PL_restartjmpenv = NULL;
@@ -2848,7 +2853,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
        FREETMPS;
        JMPENV_POP;
        my_exit_jump();
-       assert(0); /* NOTREACHED */
+       NOT_REACHED; /* NOTREACHED */
     case 3:
        if (PL_restartop) {
            PL_restartjmpenv = NULL;
@@ -2881,7 +2886,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 /*
 =for apidoc p||eval_pv
 
-Tells Perl to C<eval> the given string and return an SV* result.
+Tells Perl to C<eval> the given string in scalar context and return an SV* result.
 
 =cut
 */
@@ -3057,11 +3062,6 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
       const char *const *p = usage_msgd;
       while (*p) PerlIO_puts(PerlIO_stdout(), *p++);
     }
-#  ifdef EBCDIC
-    if ((i & DEBUG_p_FLAG) && ckWARN_d(WARN_DEBUGGING))
-       Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
-               "-Dp not implemented on this platform\n");
-#  endif
     return i;
 }
 #endif
@@ -3471,7 +3471,7 @@ S_minus_v(pTHX)
 #endif
 
        PerlIO_printf(PIO_stdout,
-                     "\n\nCopyright 1987-2014, Larry Wall\n");
+                     "\n\nCopyright 1987-2015, Larry Wall\n");
 #ifdef MSDOS
        PerlIO_printf(PIO_stdout,
                      "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
@@ -3626,7 +3626,7 @@ S_init_main_stash(pTHX)
     GvMULTI_on(PL_replgv);
     (void)Perl_form(aTHX_ "%240s",""); /* Preallocate temp - for immediate signals. */
 #ifdef PERL_DONT_CREATE_GVSV
-    gv_SVadd(PL_errgv);
+    (void)gv_SVadd(PL_errgv);
 #endif
     sv_grow(ERRSV, 240);       /* Preallocate - for immediate signals. */
     CLEAR_ERRSV();
@@ -3906,7 +3906,7 @@ Perl_doing_taint(int argc, char *argv[], char *envp[])
      * if -T are the first chars together; otherwise one gets
      *  "Too late" message. */
     if ( argc > 1 && argv[1][0] == '-'
-         && (argv[1][1] == 't' || argv[1][1] == 'T') )
+         && isALPHA_FOLD_EQ(argv[1][1], 't'))
        return 1;
     return 0;
 }
@@ -3959,6 +3959,7 @@ void
 Perl_init_debugger(pTHX)
 {
     HV * const ostash = PL_curstash;
+    MAGIC *mg;
 
     PL_curstash = (HV *)SvREFCNT_inc_simple(PL_debstash);
 
@@ -3975,12 +3976,24 @@ Perl_init_debugger(pTHX)
     PL_DBsingle = GvSV((gv_fetchpvs("DB::single", GV_ADDMULTI, SVt_PV)));
     if (!SvIOK(PL_DBsingle))
        sv_setiv(PL_DBsingle, 0);
+    mg = sv_magicext(PL_DBsingle, NULL, PERL_MAGIC_debugvar, &PL_vtbl_debugvar, 0, 0);
+    mg->mg_private = DBVARMG_SINGLE;
+    SvSETMAGIC(PL_DBsingle);
+
     PL_DBtrace = GvSV((gv_fetchpvs("DB::trace", GV_ADDMULTI, SVt_PV)));
     if (!SvIOK(PL_DBtrace))
        sv_setiv(PL_DBtrace, 0);
+    mg = sv_magicext(PL_DBtrace, NULL, PERL_MAGIC_debugvar, &PL_vtbl_debugvar, 0, 0);
+    mg->mg_private = DBVARMG_TRACE;
+    SvSETMAGIC(PL_DBtrace);
+
     PL_DBsignal = GvSV((gv_fetchpvs("DB::signal", GV_ADDMULTI, SVt_PV)));
     if (!SvIOK(PL_DBsignal))
        sv_setiv(PL_DBsignal, 0);
+    mg = sv_magicext(PL_DBsignal, NULL, PERL_MAGIC_debugvar, &PL_vtbl_debugvar, 0, 0);
+    mg->mg_private = DBVARMG_SIGNAL;
+    SvSETMAGIC(PL_DBsignal);
+
     SvREFCNT_dec(PL_curstash);
     PL_curstash = ostash;
 }
@@ -4856,7 +4869,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
            CopLINE_set(PL_curcop, oldline);
            JMPENV_POP;
            my_exit_jump();
-           assert(0); /* NOTREACHED */
+           NOT_REACHED; /* NOTREACHED */
        case 3:
            if (PL_restartop) {
                PL_curcop = &PL_compiling;
@@ -5023,6 +5036,15 @@ read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
     return 1;
 }
 
+/* removes boilerplate code at the end of each boot_Module xsub */
+void
+Perl_xs_boot_epilog(pTHX_ const U32 ax)
+{
+  if (PL_unitcheckav)
+       call_list(PL_scopestack_ix, PL_unitcheckav);
+    XSRETURN_YES;
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd
Unnamed repository; edit this file 'description' to name the repository.