Tick off 5.28.3 and 5.30.3

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index e6fe14f..422a548 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -3,7 +3,7 @@
  *
  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
  *    2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
- *    2013, 2014, 2015, 2016, 2017, 2018, 2019 by Larry Wall and others
+ *    2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -96,6 +96,7 @@ S_init_tls_and_interp(PerlInterpreter *my_perl)
        HINTS_REFCNT_INIT;
         LOCALE_INIT;
         USER_PROP_MUTEX_INIT;
+        ENV_INIT;
        MUTEX_INIT(&PL_dollarzero_mutex);
        MUTEX_INIT(&PL_my_ctx_mutex);
 #  endif
@@ -216,26 +217,6 @@ Initializes a new Perl interpreter.  See L<perlembed>.
 =cut
 */
 
-static void
-S_fixup_platform_bugs(void)
-{
-#if defined(__GLIBC__) && IVSIZE == 8 \
-    && ( __GLIBC__ < 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ < 8))
-    {
-        IV l =   3;
-        IV r = -10;
-        /* Cannot do this check with inlined IV constants since
-         * that seems to work correctly even with the buggy glibc. */
-        if (l % r == -3) {
-            dTHX;
-            /* Yikes, we have the bug.
-             * Patch in the workaround version. */
-            PL_ppaddr[OP_I_MODULO] = &Perl_pp_i_modulo_glibc_bugfix;
-        }
-    }
-#endif
-}
-
 void
 perl_construct(pTHXx)
 {
@@ -296,8 +277,6 @@ perl_construct(pTHXx)
 
     init_ids();
 
-    S_fixup_platform_bugs();
-
     JMPENV_BOOTSTRAP;
     STATUS_ALL_SUCCESS;
 
@@ -1197,9 +1176,76 @@ perl_destruct(pTHXx)
     PL_warn_locale       = NULL;
 #endif
 
-    if (!specialWARN(PL_compiling.cop_warnings))
-       PerlMemShared_free(PL_compiling.cop_warnings);
-    PL_compiling.cop_warnings = NULL;
+    SvREFCNT_dec(PL_AboveLatin1);
+    PL_AboveLatin1 = NULL;
+    SvREFCNT_dec(PL_Assigned_invlist);
+    PL_Assigned_invlist = NULL;
+    SvREFCNT_dec(PL_GCB_invlist);
+    PL_GCB_invlist = NULL;
+    SvREFCNT_dec(PL_HasMultiCharFold);
+    PL_HasMultiCharFold = NULL;
+    SvREFCNT_dec(PL_InMultiCharFold);
+    PL_InMultiCharFold = NULL;
+    SvREFCNT_dec(PL_Latin1);
+    PL_Latin1 = NULL;
+    SvREFCNT_dec(PL_LB_invlist);
+    PL_LB_invlist = NULL;
+    SvREFCNT_dec(PL_SB_invlist);
+    PL_SB_invlist = NULL;
+    SvREFCNT_dec(PL_SCX_invlist);
+    PL_SCX_invlist = NULL;
+    SvREFCNT_dec(PL_UpperLatin1);
+    PL_UpperLatin1 = NULL;
+    SvREFCNT_dec(PL_in_some_fold);
+    PL_in_some_fold = NULL;
+    SvREFCNT_dec(PL_utf8_idcont);
+    PL_utf8_idcont = NULL;
+    SvREFCNT_dec(PL_utf8_idstart);
+    PL_utf8_idstart = NULL;
+    SvREFCNT_dec(PL_utf8_perl_idcont);
+    PL_utf8_perl_idcont = NULL;
+    SvREFCNT_dec(PL_utf8_perl_idstart);
+    PL_utf8_perl_idstart = NULL;
+    SvREFCNT_dec(PL_utf8_xidcont);
+    PL_utf8_xidcont = NULL;
+    SvREFCNT_dec(PL_utf8_xidstart);
+    PL_utf8_xidstart = NULL;
+    SvREFCNT_dec(PL_WB_invlist);
+    PL_WB_invlist = NULL;
+    SvREFCNT_dec(PL_utf8_toupper);
+    PL_utf8_toupper = NULL;
+    SvREFCNT_dec(PL_utf8_totitle);
+    PL_utf8_totitle = NULL;
+    SvREFCNT_dec(PL_utf8_tolower);
+    PL_utf8_tolower = NULL;
+    SvREFCNT_dec(PL_utf8_tofold);
+    PL_utf8_tofold = NULL;
+    SvREFCNT_dec(PL_utf8_tosimplefold);
+    PL_utf8_tosimplefold = NULL;
+    SvREFCNT_dec(PL_utf8_charname_begin);
+    PL_utf8_charname_begin = NULL;
+    SvREFCNT_dec(PL_utf8_charname_continue);
+    PL_utf8_charname_continue = NULL;
+    SvREFCNT_dec(PL_utf8_mark);
+    PL_utf8_mark = NULL;
+    SvREFCNT_dec(PL_InBitmap);
+    PL_InBitmap = NULL;
+    SvREFCNT_dec(PL_CCC_non0_non230);
+    PL_CCC_non0_non230 = NULL;
+    SvREFCNT_dec(PL_Private_Use);
+    PL_Private_Use = NULL;
+
+    for (i = 0; i < POSIX_CC_COUNT; i++) {
+        SvREFCNT_dec(PL_XPosix_ptrs[i]);
+        PL_XPosix_ptrs[i] = NULL;
+
+        if (i != _CC_CASED) {   /* A copy of Alpha */
+            SvREFCNT_dec(PL_Posix_ptrs[i]);
+            PL_Posix_ptrs[i] = NULL;
+        }
+    }
+
+    free_and_set_cop_warnings(&PL_compiling, NULL);
     cophh_free(CopHINTHASH_get(&PL_compiling));
     CopHINTHASH_set(&PL_compiling, cophh_new_empty());
     CopFILE_free(&PL_compiling);
@@ -2235,10 +2281,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #endif
        (s = PerlEnv_getenv("PERL5OPT")))
     {
-        /* s points to static memory in getenv(), which may be overwritten at
-         * any time; use a mortal copy instead */
-       s = SvPVX(sv_2mortal(newSVpv(s, 0)));
-
        while (isSPACE(*s))
            s++;
        if (*s == '-' && *(s+1) == 'T') {
@@ -2267,7 +2309,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                d = s;
                if (!*s)
                    break;
-               if (!strchr("CDIMUdmtwW", *s))
+               if (!memCHRs("CDIMUdmtwW", *s))
                    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
                while (++s && *s) {
                    if (isSPACE(*s)) {
@@ -3108,6 +3150,7 @@ as C<call_sv>, with the obvious exception of C<G_EVAL>.  See L<perlcall>.
 The C<G_RETHROW> flag can be used if you only need eval_sv() to
 execute code specified by a string, but not catch any errors.
 
+=for apidoc Amnh||G_RETHROW
 =cut
 */
 
@@ -3695,16 +3738,12 @@ Perl_moreswitches(pTHX_ const char *s)
        return s;
     case 'W':
        PL_dowarn = G_WARN_ALL_ON|G_WARN_ON;
-        if (!specialWARN(PL_compiling.cop_warnings))
-            PerlMemShared_free(PL_compiling.cop_warnings);
-       PL_compiling.cop_warnings = pWARN_ALL ;
+    free_and_set_cop_warnings(&PL_compiling, pWARN_ALL);
        s++;
        return s;
     case 'X':
        PL_dowarn = G_WARN_ALL_OFF;
-        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);
        s++;
        return s;
     case '*':
@@ -3793,7 +3832,7 @@ S_minus_v(pTHX)
 #endif
 
        PerlIO_printf(PIO_stdout,
-                     "\n\nCopyright 1987-2019, Larry Wall\n");
+                     "\n\nCopyright 1987-2020, Larry Wall\n");
 #ifdef MSDOS
        PerlIO_printf(PIO_stdout,
                      "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
@@ -5204,7 +5243,7 @@ Perl_my_failure_exit(pTHX)
         * success/warning codes to fatal with out changing
         * the POSIX status code.  The severity makes VMS native
         * status handling work, while UNIX mode programs use the
-        * the POSIX exit codes.
+        * POSIX exit codes.
         */
         if ((STATUS_NATIVE & (STS$K_SEVERE|STS$K_ERROR)) == 0) {
            STATUS_NATIVE &= STS$M_COND_ID;