diff options
author | Father Chrysostomos <sprout@cpan.org> | 2011-10-25 15:40:40 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-10-26 18:22:18 -0700 |
commit | 1bb8785ab1af03172a3a220f8948d33bdc3dd374 (patch) | |
tree | a14c14464b4aa65c51fe30d11a6b79bac2bb3313 /t/run | |
parent | edfed4c3099abba2a8b83e8dde6bcff0952c07f5 (diff) | |
download | perl-1bb8785ab1af03172a3a220f8948d33bdc3dd374.tar.gz |
Rewrite csh_glob in C; fix two quoting bugs
This commit rewrites File::Glob::csh_glob (which implements perl’s
default globbing behaviour) in C.
This fixes a problem introduced by 0b0e6d70f. If there is an
unmatched quotation mark, all attempts to parse the pattern are
discarded and it is treated as a single token. Prior to 0b0e6d70f,
whitespace was stripped from both ends in that case. As of 0b0e6d70f,
it was only stripped from the beginning. This commit restores the
pre-0b0e6d70f behaviour with unmatched quotes. It doesn’t take
'a"b\ ' into account (where the space is escaped), but that wasn’t
handled properly before 0b0e6d70f, either.
This also finishes making csh_glob consistent with regard to quota-
tion marks. Commit 0b0e6d70f attempted to do that, but did not strip
out medial quotation marks, as in a"b"c. Text::ParseWords does not
provide an interface for stripping out quotation marks but leaving
backslashes, which I tried to work around, not fully understanding
the implications. Anyway, this new C implementation doesn’t use
Text::ParseWords.
The latter fix caused a test failure, but that test was there to make
sure the behaviour didn’t change depending on whether File::Glob
was loaded before the first mention of glob(). (In 5.6, loading
File::Glob first would make perl revert to external csh glob, ironic-
ally enough.) This commit modifies the test to test for sameness,
rather than exact output. In fact, this change causes perl and
miniperl to be consistent, and probably also causes glob to be more
consistent across platforms (think of VMS).
Another effect of the translation to C is that the Unicode Bug is
fixed with regard to splitting patterns. The C code effectively does
/\s/a now (which I believe is the only sane behaviour in this case),
instead of treating the string differently depending on the UTF8 flag.
The Unicode Bug is still present with regard to actual globbing.
This commit introduces one regression. This code:
undef %File::Glob::;
glob("nometachars");
will no longer return anything, because csh_glob no longer holds a
reference count on the $File::Glob::DEFAULT_FLAGS glob. Any code that
does that is beyond crazy.
The big advantage to this patch is speed. Something like
‘@files = <*>’ is 18% faster in a folder of 300 files. For smaller
folders there should be an even more notable difference.
Diffstat (limited to 't/run')
-rw-r--r-- | t/run/fresh_perl.t | 60 |
1 files changed, 17 insertions, 43 deletions
diff --git a/t/run/fresh_perl.t b/t/run/fresh_perl.t index a3874d96a5..0aaf28a800 100644 --- a/t/run/fresh_perl.t +++ b/t/run/fresh_perl.t @@ -761,49 +761,23 @@ EXPECT foo at - line 1. ######## glob() bug Mon, 01 Sep 2003 02:25:41 -0700 <200309010925.h819Pf0X011457@smtp3.ActiveState.com> -lw -BEGIN { - if ($^O eq 'os390') { - require File::Glob; - import File::Glob ':glob'; - } -} -BEGIN { - eval 'require Fcntl'; - if ($@) { print qq[./"TEST"\n./"TEST"\n]; exit 0 } # running minitest? -} -if ($^O eq 'VMS') { # VMS is not *that* kind of a glob. -print qq[./"TEST"\n./"TEST"\n]; -} else { -print glob(q(./"TEST")); -use File::Glob; -print glob(q(./"TEST")); -} -EXPECT -./"TEST" -./"TEST" -######## glob() bug Mon, 01 Sep 2003 02:25:41 -0700 <200309010925.h819Pf0X011457@smtp3.ActiveState.com> --lw -BEGIN { - if ($^O eq 'os390') { - require File::Glob; - import File::Glob ':glob'; - } -} -BEGIN { - eval 'require Fcntl'; - if ($@) { print qq[./"TEST"\n./"TEST"\n]; exit 0 } # running minitest? -} -if ($^O eq 'VMS') { # VMS is not *that* kind of a glob. -print qq[./"TEST"\n./"TEST"\n]; -} else { -use File::Glob; -print glob(q(./"TEST")); -use File::Glob; -print glob(q(./"TEST")); -} -EXPECT -./"TEST" -./"TEST" +# Make sure the presence of the CORE::GLOBAL::glob typeglob does not affect +# whether File::Glob::csh_glob is called. +++$INC{"File/Glob.pm"}; # prevent it from loading +my $called1 = +my $called2 = 0; +*File::Glob::csh_glob = sub { ++$called1 }; +my $output1 = eval q{ glob(q(./"TEST")) }; +undef *CORE::GLOBAL::glob; # but leave the typeglob itself there +++$CORE::GLOBAL::glob if 0; # "used only once" +undef *File::Glob::csh_glob; # avoid redefinition warnings +*File::Glob::csh_glob = sub { ++$called2 }; +my $output2 = eval q{ glob(q(./"TEST")) }; +print "ok1" if $called1 eq $called2; +print "ok2" if $output1 eq $output2; +EXPECT +ok1 +ok2 ######## "#75146: 27e904532594b7fb (fix for #23810) introduces a #regression" use strict; |