diff options
author | Brian Fraser <fraserbn@gmail.com> | 2013-09-21 03:19:52 -0300 |
---|---|---|
committer | Ricardo Signes <rjbs@cpan.org> | 2013-11-30 21:19:41 -0500 |
commit | d62e66462ce1e2669a3e852707aa303dd24dc6de (patch) | |
tree | ee6b1f342217ea487cf387c2956a87b98fd2eb6d | |
parent | 28dfa18010e3f64c7a59f2b74019a6cbf203f0ee (diff) | |
download | perl-d62e66462ce1e2669a3e852707aa303dd24dc6de.tar.gz |
File::Glob: Dup glob state in CLONE()
This solves [perl #119897] and [perl #117823], and restores the
behavior of glob() in conjunction with threads of 5.14 and older.
Since 5.16, code that used glob() inside a thread had been
unintentionally sharing state between threads, which lead to things
like this crashing and failing assertions:
./perl -Ilib -Mthreads -e 'scalar glob("*"); threads->create(sub { glob("*") })->join();'
(cherry picked from commit facf34ef484d62d15b2da11ee03d01942a22ff15)
-rw-r--r-- | MANIFEST | 1 | ||||
-rw-r--r-- | ext/File-Glob/Glob.xs | 33 | ||||
-rw-r--r-- | ext/File-Glob/t/threads.t | 71 |
3 files changed, 105 insertions, 0 deletions
@@ -3798,6 +3798,7 @@ ext/File-Glob/t/global.t See if File::Glob works ext/File-Glob/TODO File::Glob extension todo list ext/File-Glob/t/rt114984.t See if File::Glob works ext/File-Glob/t/taint.t See if File::Glob works +ext/File-Glob/t/threads.t See if File::Glob + threads works ext/GDBM_File/GDBM_File.pm GDBM extension Perl module ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines ext/GDBM_File/hints/sco.pl Hint for GDBM_File for named architecture diff --git a/ext/File-Glob/Glob.xs b/ext/File-Glob/Glob.xs index df5530a088..c20f124c97 100644 --- a/ext/File-Glob/Glob.xs +++ b/ext/File-Glob/Glob.xs @@ -9,6 +9,9 @@ #define MY_CXT_KEY "File::Glob::_guts" XS_VERSION typedef struct { +#ifdef USE_ITHREADS + tTHX interp; +#endif int x_GLOB_ERROR; HV * x_GLOB_ENTRIES; Perl_ophook_t x_GLOB_OLD_OPHOOK; @@ -385,6 +388,33 @@ PPCODE: iterate(aTHX_ doglob_iter_wrapper); SPAGAIN; +#ifdef USE_ITHREADS + +void +CLONE(...) +INIT: + HV *glob_entries_clone = NULL; +CODE: + PERL_UNUSED_ARG(items); + { + dMY_CXT; + if ( MY_CXT.x_GLOB_ENTRIES ) { + CLONE_PARAMS param; + param.stashes = NULL; + param.flags = 0; + param.proto_perl = MY_CXT.interp; + + glob_entries_clone = MUTABLE_HV(sv_dup_inc((SV*)MY_CXT.x_GLOB_ENTRIES, ¶m)); + } + } + { + MY_CXT_CLONE; + MY_CXT.x_GLOB_ENTRIES = glob_entries_clone; + MY_CXT.interp = aTHX; + } + +#endif + BOOT: { #ifndef PERL_EXTERNAL_GLOB @@ -400,6 +430,9 @@ BOOT: dMY_CXT; MY_CXT.x_GLOB_ENTRIES = NULL; MY_CXT.x_GLOB_OLD_OPHOOK = PL_opfreehook; +#ifdef USE_ITHREADS + MY_CXT.interp = aTHX; +#endif PL_opfreehook = glob_ophook; } } diff --git a/ext/File-Glob/t/threads.t b/ext/File-Glob/t/threads.t new file mode 100644 index 0000000000..141450ac7c --- /dev/null +++ b/ext/File-Glob/t/threads.t @@ -0,0 +1,71 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { + print "1..0\n"; + exit 0; + } +} +use strict; +use warnings; +# Test::More needs threads pre-loaded +use if $Config{useithreads}, 'threads'; +use Test::More; + +BEGIN { + if (! $Config{'useithreads'}) { + plan skip_all => "Perl not compiled with 'useithreads'"; + } +} + +use File::Temp qw(tempdir); +use File::Spec qw(); +use File::Glob qw(csh_glob); + +my($dir) = tempdir(CLEANUP => 1) + or die "Could not create temporary directory"; + +my @temp_files = qw(1_file 2_file 3_file); +for my $file (@temp_files) { + open my $fh, ">", File::Spec->catfile($dir, $file) + or die "Could not create file $dir/$file: $!"; + close $fh; +} +my $cwd = Cwd::cwd(); +chdir $dir + or die "Could not chdir to $dir: $!"; + +sub do_glob { scalar csh_glob("*") } +# Stablish some glob state +my $first_file = do_glob(); +is($first_file, $temp_files[0]); + +my @files; +push @files, threads->create(\&do_glob)->join() for 1..5; +is_deeply( + \@files, + [($temp_files[1]) x 5], + "glob() state is cloned for new threads" +); + +@files = threads->create({'context' => 'list'}, + sub { + return do_glob(), threads->create(\&do_glob)->join() + })->join(); + +is_deeply( + \@files, + [@temp_files[1,2]], + "..and for new threads inside threads" +); + +my $second_file = do_glob(); +is($second_file, $temp_files[1], "state doesn't leak from threads"); + +chdir $cwd + or die "Could not chdir back to $cwd: $!"; + +done_testing; |