Add Pod::Cache

Instead of generating pod files each time for each test that needs it, generate a cache as we go, that uses the timestamp to insure we don't regen them if not needed. This temporarily removes the concurrency from some files. Related to #1952
Raku · Jun 21, 2018 · e9a0579 · e9a0579
1 parent cffe50e
commit e9a0579
Show file tree

Hide file tree

Showing 6 changed files with 48 additions and 96 deletions.
diff --git a/.gitignore b/.gitignore
@@ -26,3 +26,4 @@ highlights/node_modules
 highlights/atom-language-perl6/
 .DS_store
 highlights/package-lock.json
+.pod-cache
diff --git a/lib/Pod/Cache.pm b/lib/Pod/Cache.pm
@@ -0,0 +1,23 @@
+unit class Pod::Cache;
+
+# Given a filename, generate a cached, rendered version of the POD
+# in that file as text.
+
+method cache-file(Str $file --> Str) {
+    my $outfile = '.pod-cache/' ~ $file;
+    my $output-io = $outfile.IO;
+
+    my $in-time = $file.IO.modified;
+    my $out-time = $output-io.e ?? $output-io.modified !! 0;
+
+    if $in-time > $out-time {
+       mkdir $output-io.dirname;
+       my $outfile = $output-io.open(:w);
+       $outfile.lock;
+       my $job = Proc::Async.new($*EXECUTABLE-NAME, '--doc', $file);
+       $job.stdout.tap(-> $buf {$outfile.print: $buf});
+
+       await $job.start;
+    }
+    $outfile
+}
diff --git a/xt/aspell.t b/xt/aspell.t
@@ -2,7 +2,9 @@
 
 use v6;
 use Test;
+
 use lib 'lib';
+use Pod::Cache;
 use Test-Files;
 
 =begin overview
@@ -23,7 +25,6 @@ text that is part of a code example)
 my @files = Test-Files.documents.grep({not $_ ~~ / 'README.' .. '.md' /});
 
 plan +@files;
-my $max-jobs = %*ENV<TEST_THREADS> // 2;
 
 my $proc = shell('aspell -v');
 if $proc.exitcode {
@@ -40,11 +41,9 @@ $dict.close;
 
 my %output;
 
-sub test-it($promises) {
-
+sub test-it($promises, $file) {
     await Promise.allof: |$promises;
     my $tasks = $promises».result;
-    my $file = $tasks[0].command[*-1];
 
     my $count;
     for %output{$file}.lines -> $line {
@@ -58,35 +57,16 @@ sub test-it($promises) {
     ok !$count, "$file has $so-many spelling errors";
 }
 
-my @jobs;
-
 for @files -> $file {
-    if $file ~~ / '.pod6' $/ {
-        my $pod = Proc::Async.new($*EXECUTABLE-NAME, '--doc', $file);
-        my $fixer = Proc::Async.new('awk', 'BEGIN {print "!"} {print "^" gsub(/[\\:]/,"",$0)}');
-        $fixer.bind-stdin: $pod.stdout: :bin;
-        my $proc = Proc::Async.new(<aspell -a -l en_US --ignore-case --extra-dicts=./xt/aspell.pws>);
-        $proc.bind-stdin: $fixer.stdout: :bin;
-        %output{$file}="";
-        $proc.stdout.tap(-> $buf { %output{$file} = %output{$file} ~ $buf });
-        $proc.stderr.tap(-> $buf {});
-        push @jobs, [$pod.start, $fixer.start, $proc.start];
-    } else {
-        my $fixer = Proc::Async.new('awk', 'BEGIN {print "!"} {print "^" $0}', $file);
-        my $proc = Proc::Async.new(<aspell -a -l en_US --ignore-case --extra-dicts=./xt/aspell.pws>);
-        $proc.bind-stdin: $fixer.stdout: :bin;
-        %output{$file}="";
-        $proc.stdout.tap(-> $buf { %output{$file} = %output{$file} ~ $buf });
-        $proc.stderr.tap(-> $buf {});
-        push @jobs, [$fixer.start, $proc.start];
-    }
-
-    if +@jobs > $max-jobs {
-        test-it(@jobs.shift);
-    }
+    my $input-file = $file.ends-with('.pod6') ?? Pod::Cache.cache-file($file) !! $file;
+
+    my $fixer = Proc::Async.new('awk', 'BEGIN {print "!"} {print "^" gsub(/[\\:]/,"",$0)}', $input-file);
+    my $proc = Proc::Async.new(<aspell -a -l en_US --ignore-case --extra-dicts=./xt/aspell.pws>);
+    $proc.bind-stdin: $fixer.stdout: :bin;
+    %output{$file}="";
+    $proc.stdout.tap(-> $buf { %output{$file} = %output{$file} ~ $buf });
+    $proc.stderr.tap(-> $buf {});
+    test-it([$fixer.start, $proc.start], $file);
 }
 
-
-@jobs.map({test-it($_)});
-
 # vim: expandtab shiftwidth=4 ft=perl6
diff --git a/xt/double-dots.t b/xt/double-dots.t
@@ -2,7 +2,9 @@
 
 use v6;
 use Test;
+
 use lib 'lib';
+use Pod::Cache;
 use Test-Files;
 
 =begin overview
@@ -14,13 +16,6 @@ Avoid using C<..> - usually a typo for C<.> or C<...>
 my @files = Test-Files.documents;
 
 plan +@files;
-my $max-jobs = %*ENV<TEST_THREADS> // 2;
-my %output;
-
-sub test-promise($promise) {
-    my $file = $promise.command[*-1];
-    test-it(%output{$file}, $file);
-}
 
 sub test-it(Str $output, Str $file) {
     my $ok = True;
@@ -35,24 +30,12 @@ sub test-it(Str $output, Str $file) {
     ok $ok, "$error: file contains ..";
 }
 
-my @jobs;
 for @files -> $file {
-
-    my $output = "";
-
-    if $file ~~ / '.pod6' $/ {
-        my $a = Proc::Async.new($*EXECUTABLE-NAME, '--doc', $file);
-        %output{$file} = "";
-        $a.stdout.tap(-> $buf { %output{$file} = %output{$file} ~ $buf });
-        push @jobs: $a.start;
-        if +@jobs > $max-jobs {
-            test-promise(await @jobs.shift)
-        }
+    if $file.ends-with('.pod6') {
+        test-it(Pod::Cache.cache-file($file).IO.slurp, $file)
     } else {
         test-it($file.IO.slurp, $file);
     }
 }
 
-for @jobs.map: {await $_} -> $r { test-promise($r) }
-
 # vim: expandtab shiftwidth=4 ft=perl6
diff --git a/xt/duplicates.t b/xt/duplicates.t
@@ -2,7 +2,9 @@
 
 use v6;
 use Test;
+
 use lib 'lib';
+use Pod::Cache;
 use Test-Files;
 
 =begin overview
@@ -23,14 +25,6 @@ my @files = Test-Files.documents \
 
 plan +@files;
 
-my $max-jobs = %*ENV<TEST_THREADS> // 2;
-my %output;
-
-sub test-promise($promise) {
-    my $file = $promise.command[*-1];
-    test-it(%output{$file}, $file);
-}
-
 sub test-it(Str $output, Str $file) {
     my $ok = True;
 
@@ -67,24 +61,12 @@ sub test-it(Str $output, Str $file) {
     is @dupes.join("\n"), '', $message;
 }
 
-my @jobs;
 for @files -> $file {
-
-    my $output = '';
-
-    if $file ~~ / '.pod6' $/ {
-        my $a = Proc::Async.new($*EXECUTABLE-NAME, '--doc', $file);
-        %output{$file} = '';
-        $a.stdout.tap(-> $buf { %output{$file} = %output{$file} ~ $buf });
-        push @jobs: $a.start;
-        if +@jobs > $max-jobs {
-            test-promise(await @jobs.shift)
-        }
+    if $file.ends-with('.pod6') {
+        test-it(Pod::Cache.cache-file($file).IO.slurp, $file)
     } else {
         test-it($file.IO.slurp, $file);
     }
 }
 
-for @jobs.map: {await $_} -> $r { test-promise($r) }
-
 # vim: expandtab shiftwidth=4 ft=perl6
diff --git a/xt/space-after-comma.t b/xt/space-after-comma.t
@@ -2,7 +2,9 @@
 
 use v6;
 use Test;
+
 use lib 'lib';
+use Pod::Cache;
 use Test-Files;
 
 =begin overview
@@ -15,13 +17,6 @@ my @files = Test-Files.documents\
     .grep({not $_ ~~ / 'README.' .. '.md' /});
 
 plan +@files;
-my $max-jobs = %*ENV<TEST_THREADS> // 2;
-my %output;
-
-sub test-promise($promise) {
-    my $file = $promise.command[*-1];
-    test-it(%output{$file}, $file);
-}
 
 sub test-it(Str $output, Str $file) {
     my $ok = True;
@@ -63,24 +58,12 @@ sub test-it(Str $output, Str $file) {
     ok $ok, "$error: $msg";
 }
 
-my @jobs;
 for @files -> $file {
-
-    my $output = "";
-
-    if $file ~~ / '.pod6' $/ {
-        my $a = Proc::Async.new($*EXECUTABLE-NAME, '--doc', $file);
-        %output{$file} = "";
-        $a.stdout.tap(-> $buf { %output{$file} = %output{$file} ~ $buf });
-        push @jobs: $a.start;
-        if +@jobs > $max-jobs {
-            test-promise(await @jobs.shift)
-        }
+    if $file.ends-with('.pod6') {
+        test-it(Pod::Cache.cache-file($file).IO.slurp, $file);
     } else {
         test-it($file.IO.slurp, $file);
     }
 }
 
-for @jobs.map: {await $_} -> $r { test-promise($r) }
-
 # vim: expandtab shiftwidth=4 ft=perl6