In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/facf34ef484d62d15b2da11ee03d01942a22ff15?hp=ce3470dcce263170c48127c11bb2a47ca92f2616>
- Log ----------------------------------------------------------------- commit facf34ef484d62d15b2da11ee03d01942a22ff15 Author: Brian Fraser <[email protected]> Date: Sat Sep 21 03:19:52 2013 -0300 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();' ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + ext/File-Glob/Glob.xs | 33 ++++++++++++++++++++++ ext/File-Glob/t/threads.t | 71 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 105 insertions(+) create mode 100644 ext/File-Glob/t/threads.t diff --git a/MANIFEST b/MANIFEST index e5489a4..0da8f13 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3707,6 +3707,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 b3705b3..118d88e 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; @@ -396,6 +399,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 @@ -411,6 +441,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 0000000..141450a --- /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; -- Perl5 Master Repository
