OS/390 cleanable gunk.

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index 2c16f91..8b3066e 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -469,8 +469,10 @@ perl_destruct(pTHXx)
     }
 
     /* jettison our possibly duplicated environment */
-
-#ifdef USE_ENVIRON_ARRAY
+    /* if PERL_USE_SAFE_PUTENV is defined environ will not have been copied
+     * so we certainly shouldn't free it here
+     */
+#if defined(USE_ENVIRON_ARRAY) && !defined(PERL_USE_SAFE_PUTENV)
     if (environ != PL_origenviron) {
        I32 i;
 
@@ -2271,7 +2273,7 @@ Perl_moreswitches(pTHX_ char *s)
                s++;
        }
        return s;
-    case 'I':  /* -I handled both here and in parse_perl() */
+    case 'I':  /* -I handled both here and in parse_body() */
        forbid_setid("-I");
        ++s;
        while (*s && isSPACE(*s))
@@ -2768,6 +2770,11 @@ sed %s -e \"/^[^#]/b\" \
                Perl_croak(aTHX_ "Can't do seteuid!\n");
        }
 #endif /* IAMSUID */
+
+        DEBUG_P(PerlIO_printf(Perl_debug_log,
+                              "PL_preprocess: cmd=\"%s\"\n",
+                              SvPVX(cmd)));
+
        PL_rsfp = PerlProc_popen(SvPVX(cmd), "r");
        SvREFCNT_dec(cmd);
        SvREFCNT_dec(cpp);
@@ -3406,6 +3413,24 @@ Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
     }
 }
 
+#ifdef HAS_PROCSELFEXE
+/* This is a function so that we don't hold on to MAXPATHLEN
+   bytes of stack longer than necessary
+ */
+STATIC void
+S_procself_val(pTHX_ SV *sv, char *arg0)
+{
+    char buf[MAXPATHLEN];
+    int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
+    if (len > 0) {
+       sv_setpvn(sv,buf,len);
+    }
+    else {
+       sv_setpv(sv,arg0);
+    }
+}
+#endif /* HAS_PROCSELFEXE */
+
 STATIC void
 S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register char **env)
 {
@@ -3438,12 +3463,17 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
        magicname("0", "0", 1);
 #endif
     }
-    if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV)))
+    if ((tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))) {/* $^X */
+#ifdef HAS_PROCSELFEXE
+       S_procself_val(aTHX_ GvSV(tmpgv), PL_origargv[0]);
+#else
 #ifdef OS2
        sv_setpv(GvSV(tmpgv), os2_execname(aTHX));
 #else
        sv_setpv(GvSV(tmpgv),PL_origargv[0]);
 #endif
+#endif
+    }
     if ((PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV))) {
        HV *hv;
        GvMULTI_on(PL_envgv);
@@ -3502,8 +3532,11 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 #endif /* USE_ENVIRON_ARRAY */
     }
     TAINT_NOT;
-    if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV)))
+    if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV))) {
+        SvREADONLY_off(GvSV(tmpgv));
        sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
+        SvREADONLY_on(GvSV(tmpgv));
+    }
 }
 
 STATIC void