Turn $$ into a magical readonly variable that always fetches getpid() instead of...

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index 127c2d4..417b2fd 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1691,6 +1691,9 @@ S_Internals_V(pTHX_ CV *cv)
 #  ifdef PERL_MEM_LOG_NOIMPL
                             " PERL_MEM_LOG_NOIMPL"
 #  endif
+#  ifdef PERL_PRESERVE_IVUV
+                            " PERL_PRESERVE_IVUV"
+#  endif
 #  ifdef PERL_USE_DEVEL
                             " PERL_USE_DEVEL"
 #  endif
@@ -1703,6 +1706,18 @@ S_Internals_V(pTHX_ CV *cv)
 #  ifdef USE_FAST_STDIO
                             " USE_FAST_STDIO"
 #  endif              
+#  ifdef USE_LOCALE
+                            " USE_LOCALE"
+#  endif
+#  ifdef USE_LOCALE_COLLATE
+                            " USE_LOCALE_COLLATE"
+#  endif
+#  ifdef USE_LOCALE_CTYPE
+                            " USE_LOCALE_CTYPE"
+#  endif
+#  ifdef USE_LOCALE_NUMERIC
+                            " USE_LOCALE_NUMERIC"
+#  endif
 #  ifdef USE_PERL_ATOF
                             " USE_PERL_ATOF"
 #  endif              
@@ -4140,11 +4155,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 #endif /* !PERL_MICRO */
     }
     TAINT_NOT;
-    if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) {
-        SvREADONLY_off(GvSV(tmpgv));
-       sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
-        SvREADONLY_on(GvSV(tmpgv));
-    }
 #ifdef THREADS_HAVE_PIDS
     PL_ppid = (IV)getppid();
 #endif
@@ -4357,6 +4367,7 @@ S_init_perllib(pTHX)
 #  define PERLLIB_MANGLE(s,n) (s)
 #endif
 
+#ifndef PERL_IS_MINIPERL
 /* Push a directory onto @INC if it exists.
    Generate a new SV if we do this, to save needing to copy the SV we push
    onto @INC  */
@@ -4378,18 +4389,16 @@ S_incpush_if_exists(pTHX_ AV *const av, SV *dir, SV *const stem)
     }
     return dir;
 }
+#endif
 
 STATIC void
 S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 {
     dVAR;
+#ifndef PERL_IS_MINIPERL
     const U8 using_sub_dirs
-#ifdef PERL_IS_MINIPERL
-        = 0;
-#else
        = (U8)flags & (INCPUSH_ADD_VERSIONED_SUB_DIRS
                       |INCPUSH_ADD_ARCHONLY_SUB_DIRS|INCPUSH_ADD_OLD_VERS);
-#endif
     const U8 add_versioned_sub_dirs
        = (U8)flags & INCPUSH_ADD_VERSIONED_SUB_DIRS;
     const U8 add_archonly_sub_dirs
@@ -4397,6 +4406,7 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
 #ifdef PERL_INC_VERSION_LIST
     const U8 addoldvers  = (U8)flags & INCPUSH_ADD_OLD_VERS;
 #endif
+#endif
     const U8 canrelocate = (U8)flags & INCPUSH_CAN_RELOCATE;
     const U8 unshift     = (U8)flags & INCPUSH_UNSHIFT;
     const U8 push_basedir = (flags & INCPUSH_NOT_BASEDIR) ? 0 : 1;
@@ -4416,7 +4426,9 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
           pushing. Hence to make it work, need to push the architecture
           (etc) libraries onto a temporary array, then "unshift" that onto
           the front of @INC.  */
+#ifndef PERL_IS_MINIPERL
        AV *const av = (using_sub_dirs) ? (unshift ? newAV() : inc) : NULL;
+#endif
 
        if (len) {
            /* I am not convinced that this is valid when PERLLIB_MANGLE is
@@ -4543,6 +4555,7 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
            }
 #endif
        }
+#ifndef PERL_IS_MINIPERL
        /*
         * BEFORE pushing libdir onto @INC we may first push version- and
         * archname-specific sub-directories.
@@ -4586,13 +4599,18 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
            assert (SvREFCNT(subdir) == 1);
            SvREFCNT_dec(subdir);
        }
-
+#endif /* !PERL_IS_MINIPERL */
        /* finally add this lib directory at the end of @INC */
        if (unshift) {
+#ifdef PERL_IS_MINIPERL
+           const U32 extra = 0;
+#else
            U32 extra = av_len(av) + 1;
+#endif
            av_unshift(inc, extra + push_basedir);
            if (push_basedir)
                av_store(inc, extra, libdir);
+#ifndef PERL_IS_MINIPERL
            while (extra--) {
                /* av owns a reference, av_store() expects to be donated a
                   reference, and av expects to be sane when it's cleared.
@@ -4607,6 +4625,7 @@ S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
                av_store(inc, extra, SvREFCNT_inc(*av_fetch(av, extra, FALSE)));
            }
            SvREFCNT_dec(av);
+#endif
        }
        else if (push_basedir) {
            av_push(inc, libdir);
@@ -4629,7 +4648,15 @@ S_incpush_use_sep(pTHX_ const char *p, STRLEN len, U32 flags)
 
     PERL_ARGS_ASSERT_INCPUSH_USE_SEP;
 
+    /* perl compiled with -DPERL_RELOCATABLE_INCPUSH will ignore the len
+     * argument to incpush_use_sep.  This allows creation of relocatable
+     * Perl distributions that patch the binary at install time.  Those
+     * distributions will have to provide their own relocation tools; this
+     * is not a feature otherwise supported by core Perl.
+     */
+#ifndef PERL_RELOCATABLE_INCPUSH
     if (!len)
+#endif
        len = strlen(p);
 
     end = p + len;