perlreapi: use parent in example, not base

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index feb031b..d832572 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -502,7 +502,7 @@ Perl_dump_sv_child(pTHX_ SV *sv)
     if (returned_errno || *buffer) {
        Perl_warn(aTHX_ "Debug leaking scalars child failed%s%.*s with errno"
                  " %d: %s", (*buffer ? " at " : ""), (int) *buffer, buffer + 1,
-                 returned_errno, strerror(returned_errno));
+                 returned_errno, Strerror(returned_errno));
     }
 }
 #endif
@@ -758,6 +758,7 @@ perl_destruct(pTHXx)
        /* ensure comppad/curpad to refer to main's pad */
        if (CvPADLIST(PL_main_cv)) {
            PAD_SET_CUR_NOSAVE(CvPADLIST(PL_main_cv), 1);
+           PL_comppad_name = PadlistNAMES(CvPADLIST(PL_main_cv));
        }
        op_free(PL_main_root);
        PL_main_root = NULL;
@@ -1347,13 +1348,11 @@ perl_free(pTHXx)
     {
 #    ifdef NETWARE
        void *host = nw_internal_host;
-#    else
-       void *host = w32_internal_host;
-#    endif
        PerlMem_free(aTHXx);
-#    ifdef NETWARE
        nw_delete_internal_host(host);
 #    else
+       void *host = w32_internal_host;
+       PerlMem_free(aTHXx);
        win32_delete_internal_host(host);
 #    endif
     }
@@ -1382,7 +1381,11 @@ __attribute__((destructor))
 perl_fini(void)
 {
     dVAR;
-    if (PL_curinterp  && !PL_veto_cleanup)
+    if (
+#ifdef PERL_GLOBAL_STRUCT_PRIVATE
+        my_vars &&
+#endif
+        PL_curinterp && !PL_veto_cleanup)
        FREE_THREAD_KEY;
 }
 
@@ -3211,13 +3214,16 @@ Perl_moreswitches(pTHX_ const char *s)
            PL_utf8cache = -1;
        return s;
     case 'F':
+       PL_minus_a = TRUE;
        PL_minus_F = TRUE;
+        PL_minus_n = TRUE;
        PL_splitstr = ++s;
        while (*s && !isSPACE(*s)) ++s;
        PL_splitstr = savepvn(PL_splitstr, s - PL_splitstr);
        return s;
     case 'a':
        PL_minus_a = TRUE;
+        PL_minus_n = TRUE;
        s++;
        return s;
     case 'c':
@@ -3836,7 +3842,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
         && S_ISDIR(tmpstatbuf.st_mode))
         Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
             CopFILE(PL_curcop),
-            strerror(EISDIR));
+            Strerror(EISDIR));
 
     return rsfp;
 }
@@ -4772,9 +4778,9 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
        /* finally add this lib directory at the end of @INC */
        if (unshift) {
 #ifdef PERL_IS_MINIPERL
-           const U32 extra = 0;
+           const Size_t extra = 0;
 #else
-           U32 extra = av_len(av) + 1;
+           Size_t extra = av_len(av) + 1;
 #endif
            av_unshift(inc, extra + push_basedir);
            if (push_basedir)
@@ -4944,6 +4950,14 @@ void
 Perl_my_exit(pTHX_ U32 status)
 {
     dVAR;
+    if (PL_exit_flags & PERL_EXIT_ABORT) {
+       abort();
+    }
+    if (PL_exit_flags & PERL_EXIT_WARN) {
+       PL_exit_flags |= PERL_EXIT_ABORT; /* Protect against reentrant calls */
+       Perl_warn(aTHX_ "Unexpected exit %u", status);
+       PL_exit_flags &= ~PERL_EXIT_ABORT;
+    }
     switch (status) {
     case 0:
        STATUS_ALL_SUCCESS;
@@ -5041,6 +5055,14 @@ Perl_my_failure_exit(pTHX)
            STATUS_UNIX_SET(255);
     }
 #endif
+    if (PL_exit_flags & PERL_EXIT_ABORT) {
+       abort();
+    }
+    if (PL_exit_flags & PERL_EXIT_WARN) {
+       PL_exit_flags |= PERL_EXIT_ABORT; /* Protect against reentrant calls */
+       Perl_warn(aTHX_ "Unexpected exit failure %u", PL_statusvalue);
+       PL_exit_flags &= ~PERL_EXIT_ABORT;
+    }
     my_exit_jump();
 }