Lock .precomp during precompilation of a module

Prevents multiple processes precomping the same file and processes loading precompiled files that are not yet fully written.
rakudo · Nov 15, 2015 · 08c55d5 · 08c55d5
1 parent 2163a7e
commit 08c55d5
Show file tree

Hide file tree

Showing 2 changed files with 32 additions and 3 deletions.
diff --git a/src/core/CompUnit/PrecompilationRepository.pm b/src/core/CompUnit/PrecompilationRepository.pm
@@ -24,6 +24,7 @@ class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationR
         if $path {
             my $preserve_global := nqp::ifnull(nqp::gethllsym('perl6', 'GLOBAL'), Mu);
             my $handle := CompUnit::Loader.load-precompilation-file($path);
+            self.store.unlock;
             nqp::bindhllsym('perl6', 'GLOBAL', $preserve_global);
             CATCH {
                 default {
@@ -41,8 +42,12 @@ class CompUnit::PrecompilationRepository::Default does CompUnit::PrecompilationR
     method precompile(CompUnit:D $compunit, CompUnit::PrecompilationId $id) {
         my $io = self.store.destination($*PERL.compiler.id, $id);
         my $path = $compunit.path;
-        die "Cannot pre-compile over a newer existing file: $io"
-          if $io.e && $io.modified > $path.modified;
+        if $io.e && $io.modified > $path.IO.modified {
+            # someone else got there first between us checking for existence
+            # of the precomp file and write locking the store
+            self.store.unlock;
+            return True;
+        }
 
         my Mu $opts := nqp::atkey(%*COMPILING, '%?OPTIONS');
         my $lle = !nqp::isnull($opts) && !nqp::isnull(nqp::atkey($opts, 'll-exception'))
@@ -60,6 +65,7 @@ RAKUDO_MODULE_DEBUG("Precomping with %*ENV<RAKUDO_PRECOMP_WITH>")
         my $result = '';
         $result ~= $_ for $proc.out.lines;
         $proc.out.close;
+        self.store.unlock;
         if $proc.status -> $status {  # something wrong
             $result ~= "Return status $status\n";
             fail $result if $result;

diff --git a/src/core/CompUnit/PrecompilationStore/File.pm b/src/core/CompUnit/PrecompilationStore/File.pm
@@ -1,5 +1,10 @@
 class CompUnit::PrecompilationStore::File does CompUnit::PrecompilationStore {
     has IO::Path $.prefix is required;
+    has IO::Handle $!lock;
+
+    submethod BUILD(IO::Path :$!prefix) {
+        $!prefix.mkdir;
+    }
 
     method !dir(CompUnit::PrecompilationId $compiler-id,
                 CompUnit::PrecompilationId $precomp-id)
@@ -15,18 +20,35 @@ class CompUnit::PrecompilationStore::File does CompUnit::PrecompilationStore {
         self!dir($compiler-id, $precomp-id).child($precomp-id.IO)
     }
 
+    method !lock(Int:D $mode) {
+        return if $*W && $*W.is_precompilation_mode();
+        $!lock //= $.prefix.child('.lock').open(:create, :rw);
+        $!lock.lock($mode);
+    }
+
+    method unlock() {
+        $!lock ?? $!lock.unlock !! True;
+    }
+
     method load(CompUnit::PrecompilationId $compiler-id,
                 CompUnit::PrecompilationId $precomp-id)
     {
         my $path = self!path($compiler-id, $precomp-id);
-        $path ~~ :e ?? $path.Str !! Str
+        if $path ~~ :e {
+            self!lock(1);
+            $path.Str
+        }
+        else {
+             Str
+        }
     }
 
     method destination(CompUnit::PrecompilationId $compiler-id,
                        CompUnit::PrecompilationId $precomp-id)
         returns IO::Path
     {
         my $dest = self!dir($compiler-id, $precomp-id);
+        self!lock(2);
         $dest.mkdir;
         $dest.child($precomp-id.IO)
     }
@@ -36,6 +58,7 @@ class CompUnit::PrecompilationStore::File does CompUnit::PrecompilationStore {
                  Str:D $path)
     {
         $path.IO.copy(self.destination($compiler-id, $precomp-id));
+        self.unlock;
     }
 
     method delete(CompUnit::PrecompilationId $compiler-id, CompUnit::PrecompilationId $precomp-id)