From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 2 Jan 2005 22:49:49 +0000 (+0000)
Subject: Change 23727 broke code that relied on \ being escaped.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=48c4c8631a1d991929e0c3a63face75159cdfddb;p=p5sagit%2Fp5-mst-13.2.git

Change 23727 broke code that relied on \ being escaped.
Fix this. *Everything* should work now.

p4raw-id: //depot/perl@23730
---

diff --git a/MANIFEST b/MANIFEST
index 7ffef32..5a22852 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2768,6 +2768,7 @@ t/run/switchC.t			Test the -C switch
 t/run/switchd.t			Test the -d switch
 t/run/switches.t		Tests for the other switches (-0, -l, -c, -s, -M, -m, -V, -v, -h, -z, -i)
 t/run/switchF.t			Test the -F switch
+t/run/switchF1.t		Pathological tests for the -F switch
 t/run/switchI.t			Test the -I switch
 t/run/switchn.t			Test the -n switch
 t/run/switchp.t			Test the -p switch
diff --git a/t/run/switchF1.t b/t/run/switchF1.t
new file mode 100644
index 0000000..fc59645
--- /dev/null
+++ b/t/run/switchF1.t
@@ -0,0 +1,31 @@
+#!perl -w
+print "1..5\n";
+
+my $file = "F-Pathological.pl";
+
+open F, ">$file" or die "Open $file: $!";
+
+my $prog = <<'EOT';
+#!./perl -anF[~#QQ\\xq']
+
+BEGIN {
+    *ARGV = *DATA;
+}
+print "@F";
+
+__DATA__
+okx1
+okq2
+ok\3
+ok'4
+EOT
+
+# 2 of the characters toke.c used to use to quote the split parameter:
+$prog =~ s/QQ/\x01\x80/;
+# These 2 plus ~ # and ' were enough to make perl choke
+print F $prog;
+close F or die "Close $file: $!";
+
+print system ($^X, $file) ? "not ok 5\n" : "ok 5\n";
+
+unlink $file or die "Unlink $file: $!";
diff --git a/toke.c b/toke.c
index 1aceaec..5757520 100644
--- a/toke.c
+++ b/toke.c
@@ -2594,9 +2594,22 @@ Perl_yylex(pTHX)
 			else {
 			    /* "q\0${splitstr}\0" is legal perl. Yes, even NUL
 			       bytes can be used as quoting characters.  :-) */
-			    Perl_sv_catpvf(aTHX_ PL_linestr,
-					   "our @F=split(q%c%s%c);",
-					   0, PL_splitstr, 0);
+			    /* The count here deliberately includes the NUL
+			       that terminates the C string constant.  This
+			       embeds the opening NUL into the string.  */
+			    Perl_sv_catpvn(aTHX_ PL_linestr,
+					   "our @F=split(q", 15);
+			    s = PL_splitstr;
+			    do {
+				/* Need to \ \s  */
+				if (*s == '\\')
+				    sv_catpvn(PL_linestr, s, 1);
+				sv_catpvn(PL_linestr, s, 1);
+			    } while (*s++);
+			    /* This loop will embed the trailing NUL of
+			       PL_linestr as the last thing it does before
+			       terminating.  */
+			    Perl_sv_catpvn(aTHX_ PL_linestr, ");", 2);
 			}
 		    }
 		    else