Created
January 23, 2018 06:14
-
-
Save lefth/8fefc16fa6de74a6c94ea21e84fbe461 to your computer and use it in GitHub Desktop.
Concurrent Path operations Windows error
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env perl6 | |
use Test; | |
my IO::Path $root-dir = ".".IO.absolute.IO; | |
sub setup { | |
mkdir 'files/40001/20006/10002'; | |
'files/40001/20006/10002/0111'.IO.open(:w).close; | |
mkdir 'files/40009/20032'; | |
'files/40009/20032/0999'.IO.open(:w).close; | |
} | |
# Recursively explore a path. | |
# NOTE: with a non-threaded version of this function, the error | |
# happens much less frequently and is very hard to reproduce. | |
sub all-paths(--> List) { # List of IO::Path | |
my $result = Channel.new; | |
my $dirs = Channel.new; | |
$dirs.send: $root-dir; | |
loop | |
{ | |
$dirs.close; | |
my @dirs := $dirs.list; | |
last if !@dirs; | |
$dirs := Channel.new; | |
race for @dirs -> $dir { | |
race for $dir.dir -> IO::Path $path { | |
if ($path.d) { | |
$dirs.send: $path; | |
} else { | |
$result.send: $path; | |
} | |
} | |
} | |
} | |
$result.close; | |
return $result.list; | |
} | |
#sub all-paths(--> List) { | |
# my @dirs = $root-dir; | |
# my @results; | |
# while @dirs { | |
# for @dirs.pop.dir -> $path { | |
# if $path.d { | |
# @dirs.push: $path; | |
# } else { | |
# @results.push: $path; | |
# } | |
# } | |
# } | |
# return @results; | |
#} | |
sub MAIN() | |
{ | |
setup; | |
my @search-strings = ( '0999', '0111' ); | |
for ^100 { | |
race for @search-strings.race(:batch<1>) -> $search-string { | |
for all-paths() -> IO::Path $file-path { | |
if ($file-path.Str.contains($search-string)) { | |
# NOTE: the basename isn't wrong, but the relative path is. | |
my Str $relative = $file-path.relative; | |
my $basename = $file-path.basename; | |
my $manual-basename = S/ .* <[\\/]> // given $relative; | |
is $basename, $manual-basename | |
or note "File path is $file-path (relative: $relative)"; | |
} | |
} | |
} | |
} | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment