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 (file)
--- 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 (file)
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 (file)
--- 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