Skip to content

Commit e9a0579

Browse files
committed
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
1 parent cffe50e commit e9a0579

File tree

6 files changed

+48
-96
lines changed

6 files changed

+48
-96
lines changed

.gitignore

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -26,3 +26,4 @@ highlights/node_modules
2626
highlights/atom-language-perl6/
2727
.DS_store
2828
highlights/package-lock.json
29+
.pod-cache

lib/Pod/Cache.pm

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
unit class Pod::Cache;
2+
3+
# Given a filename, generate a cached, rendered version of the POD
4+
# in that file as text.
5+
6+
method cache-file(Str $file --> Str) {
7+
my $outfile = '.pod-cache/' ~ $file;
8+
my $output-io = $outfile.IO;
9+
10+
my $in-time = $file.IO.modified;
11+
my $out-time = $output-io.e ?? $output-io.modified !! 0;
12+
13+
if $in-time > $out-time {
14+
mkdir $output-io.dirname;
15+
my $outfile = $output-io.open(:w);
16+
$outfile.lock;
17+
my $job = Proc::Async.new($*EXECUTABLE-NAME, '--doc', $file);
18+
$job.stdout.tap(-> $buf {$outfile.print: $buf});
19+
20+
await $job.start;
21+
}
22+
$outfile
23+
}

xt/aspell.t

Lines changed: 12 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,9 @@
22

33
use v6;
44
use Test;
5+
56
use lib 'lib';
7+
use Pod::Cache;
68
use Test-Files;
79

810
=begin overview
@@ -23,7 +25,6 @@ text that is part of a code example)
2325
my @files = Test-Files.documents.grep({not $_ ~~ / 'README.' .. '.md' /});
2426

2527
plan +@files;
26-
my $max-jobs = %*ENV<TEST_THREADS> // 2;
2728

2829
my $proc = shell('aspell -v');
2930
if $proc.exitcode {
@@ -40,11 +41,9 @@ $dict.close;
4041

4142
my %output;
4243

43-
sub test-it($promises) {
44-
44+
sub test-it($promises, $file) {
4545
await Promise.allof: |$promises;
4646
my $tasks = $promises».result;
47-
my $file = $tasks[0].command[*-1];
4847

4948
my $count;
5049
for %output{$file}.lines -> $line {
@@ -58,35 +57,16 @@ sub test-it($promises) {
5857
ok !$count, "$file has $so-many spelling errors";
5958
}
6059

61-
my @jobs;
62-
6360
for @files -> $file {
64-
if $file ~~ / '.pod6' $/ {
65-
my $pod = Proc::Async.new($*EXECUTABLE-NAME, '--doc', $file);
66-
my $fixer = Proc::Async.new('awk', 'BEGIN {print "!"} {print "^" gsub(/[\\:]/,"",$0)}');
67-
$fixer.bind-stdin: $pod.stdout: :bin;
68-
my $proc = Proc::Async.new(<aspell -a -l en_US --ignore-case --extra-dicts=./xt/aspell.pws>);
69-
$proc.bind-stdin: $fixer.stdout: :bin;
70-
%output{$file}="";
71-
$proc.stdout.tap(-> $buf { %output{$file} = %output{$file} ~ $buf });
72-
$proc.stderr.tap(-> $buf {});
73-
push @jobs, [$pod.start, $fixer.start, $proc.start];
74-
} else {
75-
my $fixer = Proc::Async.new('awk', 'BEGIN {print "!"} {print "^" $0}', $file);
76-
my $proc = Proc::Async.new(<aspell -a -l en_US --ignore-case --extra-dicts=./xt/aspell.pws>);
77-
$proc.bind-stdin: $fixer.stdout: :bin;
78-
%output{$file}="";
79-
$proc.stdout.tap(-> $buf { %output{$file} = %output{$file} ~ $buf });
80-
$proc.stderr.tap(-> $buf {});
81-
push @jobs, [$fixer.start, $proc.start];
82-
}
83-
84-
if +@jobs > $max-jobs {
85-
test-it(@jobs.shift);
86-
}
61+
my $input-file = $file.ends-with('.pod6') ?? Pod::Cache.cache-file($file) !! $file;
62+
63+
my $fixer = Proc::Async.new('awk', 'BEGIN {print "!"} {print "^" gsub(/[\\:]/,"",$0)}', $input-file);
64+
my $proc = Proc::Async.new(<aspell -a -l en_US --ignore-case --extra-dicts=./xt/aspell.pws>);
65+
$proc.bind-stdin: $fixer.stdout: :bin;
66+
%output{$file}="";
67+
$proc.stdout.tap(-> $buf { %output{$file} = %output{$file} ~ $buf });
68+
$proc.stderr.tap(-> $buf {});
69+
test-it([$fixer.start, $proc.start], $file);
8770
}
8871

89-
90-
@jobs.map({test-it($_)});
91-
9272
# vim: expandtab shiftwidth=4 ft=perl6

xt/double-dots.t

Lines changed: 4 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,9 @@
22

33
use v6;
44
use Test;
5+
56
use lib 'lib';
7+
use Pod::Cache;
68
use Test-Files;
79

810
=begin overview
@@ -14,13 +16,6 @@ Avoid using C<..> - usually a typo for C<.> or C<...>
1416
my @files = Test-Files.documents;
1517

1618
plan +@files;
17-
my $max-jobs = %*ENV<TEST_THREADS> // 2;
18-
my %output;
19-
20-
sub test-promise($promise) {
21-
my $file = $promise.command[*-1];
22-
test-it(%output{$file}, $file);
23-
}
2419

2520
sub test-it(Str $output, Str $file) {
2621
my $ok = True;
@@ -35,24 +30,12 @@ sub test-it(Str $output, Str $file) {
3530
ok $ok, "$error: file contains ..";
3631
}
3732

38-
my @jobs;
3933
for @files -> $file {
40-
41-
my $output = "";
42-
43-
if $file ~~ / '.pod6' $/ {
44-
my $a = Proc::Async.new($*EXECUTABLE-NAME, '--doc', $file);
45-
%output{$file} = "";
46-
$a.stdout.tap(-> $buf { %output{$file} = %output{$file} ~ $buf });
47-
push @jobs: $a.start;
48-
if +@jobs > $max-jobs {
49-
test-promise(await @jobs.shift)
50-
}
34+
if $file.ends-with('.pod6') {
35+
test-it(Pod::Cache.cache-file($file).IO.slurp, $file)
5136
} else {
5237
test-it($file.IO.slurp, $file);
5338
}
5439
}
5540

56-
for @jobs.map: {await $_} -> $r { test-promise($r) }
57-
5841
# vim: expandtab shiftwidth=4 ft=perl6

xt/duplicates.t

Lines changed: 4 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,9 @@
22

33
use v6;
44
use Test;
5+
56
use lib 'lib';
7+
use Pod::Cache;
68
use Test-Files;
79

810
=begin overview
@@ -23,14 +25,6 @@ my @files = Test-Files.documents \
2325

2426
plan +@files;
2527

26-
my $max-jobs = %*ENV<TEST_THREADS> // 2;
27-
my %output;
28-
29-
sub test-promise($promise) {
30-
my $file = $promise.command[*-1];
31-
test-it(%output{$file}, $file);
32-
}
33-
3428
sub test-it(Str $output, Str $file) {
3529
my $ok = True;
3630

@@ -67,24 +61,12 @@ sub test-it(Str $output, Str $file) {
6761
is @dupes.join("\n"), '', $message;
6862
}
6963

70-
my @jobs;
7164
for @files -> $file {
72-
73-
my $output = '';
74-
75-
if $file ~~ / '.pod6' $/ {
76-
my $a = Proc::Async.new($*EXECUTABLE-NAME, '--doc', $file);
77-
%output{$file} = '';
78-
$a.stdout.tap(-> $buf { %output{$file} = %output{$file} ~ $buf });
79-
push @jobs: $a.start;
80-
if +@jobs > $max-jobs {
81-
test-promise(await @jobs.shift)
82-
}
65+
if $file.ends-with('.pod6') {
66+
test-it(Pod::Cache.cache-file($file).IO.slurp, $file)
8367
} else {
8468
test-it($file.IO.slurp, $file);
8569
}
8670
}
8771

88-
for @jobs.map: {await $_} -> $r { test-promise($r) }
89-
9072
# vim: expandtab shiftwidth=4 ft=perl6

xt/space-after-comma.t

Lines changed: 4 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,9 @@
22

33
use v6;
44
use Test;
5+
56
use lib 'lib';
7+
use Pod::Cache;
68
use Test-Files;
79

810
=begin overview
@@ -15,13 +17,6 @@ my @files = Test-Files.documents\
1517
.grep({not $_ ~~ / 'README.' .. '.md' /});
1618

1719
plan +@files;
18-
my $max-jobs = %*ENV<TEST_THREADS> // 2;
19-
my %output;
20-
21-
sub test-promise($promise) {
22-
my $file = $promise.command[*-1];
23-
test-it(%output{$file}, $file);
24-
}
2520

2621
sub test-it(Str $output, Str $file) {
2722
my $ok = True;
@@ -63,24 +58,12 @@ sub test-it(Str $output, Str $file) {
6358
ok $ok, "$error: $msg";
6459
}
6560

66-
my @jobs;
6761
for @files -> $file {
68-
69-
my $output = "";
70-
71-
if $file ~~ / '.pod6' $/ {
72-
my $a = Proc::Async.new($*EXECUTABLE-NAME, '--doc', $file);
73-
%output{$file} = "";
74-
$a.stdout.tap(-> $buf { %output{$file} = %output{$file} ~ $buf });
75-
push @jobs: $a.start;
76-
if +@jobs > $max-jobs {
77-
test-promise(await @jobs.shift)
78-
}
62+
if $file.ends-with('.pod6') {
63+
test-it(Pod::Cache.cache-file($file).IO.slurp, $file);
7964
} else {
8065
test-it($file.IO.slurp, $file);
8166
}
8267
}
8368

84-
for @jobs.map: {await $_} -> $r { test-promise($r) }
85-
8669
# vim: expandtab shiftwidth=4 ft=perl6

0 commit comments

Comments
 (0)