This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make csh_glob remove quote-escaping backslashes
authorFather Chrysostomos <sprout@cpan.org>
Thu, 27 Oct 2011 21:26:15 +0000 (14:26 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 27 Oct 2011 21:26:15 +0000 (14:26 -0700)
This commit does not change the output on Unix.  On Windows, where the
globbing engine does not usually treat backslashes as escapes, this
restores the behaviour to what it was before commit 0b0e6d70, for
cases like glob('a\"b c\"d').

Before 0b0e6d70, the preprocessing done by csh_glob (which it out-
sourced to Text::ParseWords) would remove backslash escapes, so the
globbing engine got to see a"b and c"d.

Since 0b0e6d70, the backslash escapes were no longer removed (because
in most cases they needed to remain, to avoid backslashitis), so the
globbing engine got to see a\"b and c\"d.  On Unix that made no dif-
ference, as the globbing engine treats \ as an escape character.  But
on Windows it doesn’t usually, so the output changed and produced a
literal a\"b.

This commit strips out quote-escaping backslashes in the prepro-
cessing code.

ext/File-Glob/Glob.xs
ext/File-Glob/t/basic.t

index 9d35ac2..c055d1b 100644 (file)
@@ -125,6 +125,7 @@ csh_glob(pTHX)
            case '"' :
              {
                bool found = FALSE;
            case '"' :
              {
                bool found = FALSE;
+               const char quote = *s;
                if (!word) {
                    word = newSVpvs("");
                    if (is_utf8) SvUTF8_on(word);
                if (!word) {
                    word = newSVpvs("");
                    if (is_utf8) SvUTF8_on(word);
@@ -132,8 +133,14 @@ csh_glob(pTHX)
                if (piece) sv_catpvn(word, piece, s-piece);
                piece = s+1;
                while (++s <= patend)
                if (piece) sv_catpvn(word, piece, s-piece);
                piece = s+1;
                while (++s <= patend)
-                   if (*s == '\\') s++;
-                   else if (*s == *(piece-1)) {
+                   if (*s == '\\') {
+                       s++;
+                       /* If the backslash is here to escape a quote,
+                          obliterate it. */
+                       if (s < patend && *s == quote)
+                           sv_catpvn(word, piece, s-piece-1), piece = s;
+                   }
+                   else if (*s == quote) {
                        sv_catpvn(word, piece, s-piece);
                        piece = NULL;
                        found = TRUE;
                        sv_catpvn(word, piece, s-piece);
                        piece = NULL;
                        found = TRUE;
@@ -164,7 +171,20 @@ csh_glob(pTHX)
                }
                break;
              }
                }
                break;
              }
-           case '\\': if (!piece) piece = s; s++; break;
+           case '\\':
+               if (!piece) piece = s;
+               s++;
+               /* If the backslash is here to escape a quote,
+                  obliterate it. */
+               if (s < patend && (*s == '"' || *s == '\'')) {
+                   if (!word) {
+                       word = newSVpvn(piece,s-piece-1);
+                       if (is_utf8) SvUTF8_on(word);
+                   }
+                   else sv_catpvn(word, piece, s-piece-1);
+                   piece = s;
+               }
+               break;
            default:
                if (isSPACE(*s)) {
                    if (piece) {
            default:
                if (isSPACE(*s)) {
                    if (piece) {
index 309e2bb..df2b958 100644 (file)
@@ -10,7 +10,7 @@ BEGIN {
     }
 }
 use strict;
     }
 }
 use strict;
-use Test::More tests => 25;
+use Test::More tests => 29;
 BEGIN {use_ok('File::Glob', ':glob')};
 use Cwd ();
 
 BEGIN {use_ok('File::Glob', ':glob')};
 use Cwd ();
 
@@ -248,3 +248,7 @@ is_deeply [<\\* .\\*>], [<\\*>,<.\\*>], 'backslashes with(out) spaces';
 like <\\ >, qr/^\\? \z/, 'final escaped space';
 is <a"b>, 'a"b', 'unmatched quote';
 is < a"b >, 'a"b', 'unmatched quote with surrounding spaces';
 like <\\ >, qr/^\\? \z/, 'final escaped space';
 is <a"b>, 'a"b', 'unmatched quote';
 is < a"b >, 'a"b', 'unmatched quote with surrounding spaces';
+is glob('a\"b'), 'a"b', '\ before quote *only* escapes quote';
+is glob(q"a\'b"), "a'b", '\ before single quote *only* escapes quote';
+is glob('"a\"b c\"d"'), 'a"b c"d', 'before \" within "..."';
+is glob(q"'a\'b c\'d'"), "a'b c'd", q"before \' within '...'";