perl.c change to use HAS_PROCSELFEXE, also

tweak to $^X test to comprehend full path to real executable
being returned (like Cygwin as it happens...)

p4raw-id: //depot/perlio@13138

diff --git a/perl.c b/perl.c
index 710ae84..4b3eb60 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2777,8 +2777,8 @@ sed %s -e \"/^[^#]/b\" \
        }
 #endif /* IAMSUID */
 
-        DEBUG_P(PerlIO_printf(Perl_debug_log, 
-                              "PL_preprocess: cmd=\"%s\"\n", 
+        DEBUG_P(PerlIO_printf(Perl_debug_log,
+                              "PL_preprocess: cmd=\"%s\"\n",
                               SvPVX(cmd)));
 
        PL_rsfp = PerlProc_popen(SvPVX(cmd), "r");
@@ -3419,6 +3419,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("/proc/self/exe", 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)
 {
@@ -3451,12 +3469,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))) /* $^X */
+    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);

diff --git a/t/op/magic.t b/t/op/magic.t
index 73dc8a6..4e47414 100755 (executable)
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -8,6 +8,7 @@ BEGIN {
 }
 
 use warnings;
+use Config;
 
 my $test = 1;
 sub ok {
@@ -71,7 +72,7 @@ if ($Is_MSWin32 || $Is_NetWare || $Is_Dos || $Is_MPE || $Is_MacOS) {
 else {
   # the next tests are done in a subprocess because sh spits out a
   # newline onto stderr when a child process kills itself with SIGINT.
-  # We use a pipe rather than system() because the VMS command buffer 
+  # We use a pipe rather than system() because the VMS command buffer
   # would overflow with a command that long.
 
     open( CMDPIPE, "| $PERL");
@@ -148,7 +149,7 @@ ok $$ > 0, $$;
     if ($^O eq 'qnx') {
        chomp($wd = `/usr/bin/fullpath -t`);
     }
-    elsif($Is_Cygwin) {
+    elsif($Is_Cygwin || $Config{'d_procselfexe'}) {
        # Cygwin turns the symlink into the real file
        chomp($wd = `pwd`);
        $wd =~ s#/t$##;