From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Mon, 8 Jul 2002 20:10:15 +0000 (+0000)
Subject: Integrate maint patches #17421, #17424:
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=556c1dec75ad51f872cfdfbbd8c86d5def08c80b;p=p5sagit%2Fp5-mst-13.2.git

Integrate maint patches #17421, #17424:

on platforms like HP-UX that are subject to the ARG_ZERO_IS_SCRIPT
hack, $^X was improperly set to the script name when the script
was run via the PATH; argv[0] in that case shows up as the bare
name of the script rather than its fully qualified path, which
meant that the sanity check in the ARG_ZERO_IS_SCRIPT code fails
to recognize it as the running script name; fix tries to match
bare script name in that case (from Gisle Aas)

tweak change#17421 ($0 is full path to script even when script
is invoked via PATH almost everywhere except Windows)
p4raw-link: @17421 on //depot/maint-5.6/perl: 32099b6ba13a228ffd08d5c7359d07c687b11471

p4raw-id: //depot/perl@17425
p4raw-integrated: from //depot/maint-5.6/perl@17423 'edit in'
	t/op/magic.t (@17421..) 'merge in' toke.c (@16508..)
---

diff --git a/t/op/magic.t b/t/op/magic.t
index 436e253..ab0544e 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -226,7 +226,18 @@ EOF
     s/\.exe//i if $Is_Dos or $Is_os2;
     s{\\}{/}g;
     ok((($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1: after `$perl $script`");
-    ok unlink($script), $!;
+
+    local $ENV{PATH}= ".";
+    (my $script_name = $script) =~ s/.*(show-shebang)/$1/;
+    $s1 = "\$^X is $perl, \$0 is $script_name\n" if $Is_MSWin32;
+    $_ = `$script_name`;
+    s/\.exe//i if $Is_Dos or $Is_Cygwin or $Is_os2;
+    s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
+    s{is perl}{is $perl}; # for systems where $^X is only a basename
+    s{\\}{/}g;
+    ok((($Is_MSWin32 || $Is_os2) ? uc($_) eq uc($s1) : $_ eq $s1), " :$_:!=:$s1:");
+
+    unlink($script) || die "unlink($script): $!";
 }
 
 # $], $^O, $^T
diff --git a/toke.c b/toke.c
index 4077c60..8d8ac54 100644
--- a/toke.c
+++ b/toke.c
@@ -2614,6 +2614,19 @@ Perl_yylex(pTHX)
 			sv_setpvn(x, ipath, ipathend - ipath);
 			SvSETMAGIC(x);
 		    }
+		    else {
+			STRLEN blen;
+			STRLEN llen;
+			char *bstart = SvPV(CopFILESV(PL_curcop),blen);
+			char *lstart = SvPV(x,llen);
+			if (llen < blen) {
+			    bstart += blen - llen;
+			    if (strnEQ(bstart, lstart, llen) &&	bstart[-1] == '/') {
+				sv_setpvn(x, ipath, ipathend - ipath);
+				SvSETMAGIC(x);
+			    }
+			}
+		    }
 		    TAINT_NOT;	/* $^X is always tainted, but that's OK */
 		}
 #endif /* ARG_ZERO_IS_SCRIPT */