-
-
Notifications
You must be signed in to change notification settings - Fork 372
/
Helpers.pm6
308 lines (252 loc) · 10.1 KB
/
Helpers.pm6
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
unit module Test::Helpers;
use Test;
sub group-of (
Pair (
Int:D :key($plan),
Pair :value((
Str:D :key($desc),
:value(&tests))))
) is export {
subtest $desc => {
plan $plan;
tests
}
}
sub is-run (
Str() $code, $desc = "$code runs",
Stringy :$in, :@compiler-args, :@args, :$out = '', :$err = '', :$exitcode = 0
) is export {
my @proc-args = flat do if $*DISTRO.is-win {
# $*EXECUTABLE is a batch file on Windows, that goes through cmd.exe
# and chokes on standard quoting. We also need to remove any newlines
<cmd.exe /S /C>, $*EXECUTABLE, @compiler-args, '-e',
($code, @args).subst(:g, "\n", " ")
}
else {
$*EXECUTABLE, @compiler-args, '-e', $code, @args
}
with run :in, :out, :err, @proc-args {
$in ~~ Blob ?? .in.write: $in !! .in.print: $in if $in;
$ = .in.close;
my $proc-out = .out.slurp: :close;
my $proc-err = .err.slurp: :close;
my $proc-exitcode = .exitcode;
my $wanted-exitcode = $exitcode // 0;
my $wanted-out = $out // '';
my $wanted-err = $err // '';
subtest $desc => {
plan 3;
cmp-ok $proc-out, '~~', $wanted-out, 'STDOUT';
cmp-ok $proc-err, '~~', $wanted-err, 'STDERR';
cmp-ok $proc-exitcode, '~~', $wanted-exitcode, 'Exit code';
}
}
}
multi sub is-run-repl ($code, $out, $desc, |c) is export {
is-run-repl $code, $desc, :$out, |c;
}
multi sub is-run-repl ($code is copy, $desc, :$out = '', :$err = '',
:$line-editor = 'none'
) is export {
$code .= join: "\n" if $code ~~ Positional|Seq;
(temp %*ENV)<RAKUDO_ERROR_COLOR RAKUDO_LINE_EDITOR> = 0, $line-editor;
my $proc = run $*EXECUTABLE, '--repl-mode=interactive', :in, :out, :err;
$proc.in.print: $code;
$proc.in.close;
subtest {
plan +($out, $err).grep: *.defined;
sub run-test ($_, $output, $test-name) {
when Str { is $output, $_, $test-name; }
when Regex { like $output, $_, $test-name; }
when Callable { ok $_($output), $test-name or diag $output; }
when Positional|Seq {
is $output, .join("\n")~"\n", $test-name;
}
die "Don't know how to handle test of type $_.^name()";
}
run-test $_, ($*REPL-SCRUBBER//{$_})($proc.out.slurp: :close),
'stdout is correct' with $out;
run-test $_, $proc.err.slurp(:close), 'stderr is correct' with $err;
}, $desc;
}
multi sub doesn't-hang (Str $args, $desc, :$in, :$wait = 15, :$out, :$err)
is export {
doesn't-hang \($*EXECUTABLE.absolute, '-e', $args), $desc,
:$in, :$wait, :$out, :$err;
}
# TODO XXX: for some reason shoving this variable inside the routine and
# using `state` instead of `my` results in it having value 0
my $VM-time-scale-multiplier = $*VM.name eq 'jvm' ?? 20/3 !! 1;
multi sub doesn't-hang (
Capture $args, $desc = 'code does not hang',
:$in, :$wait = 15, :$out, :$err,
) is export {
my $prog = Proc::Async.new: |$args;
my ($stdout, $stderr) = '', '';
$prog.stdout.tap: { $stdout ~= $^a };
$prog.stderr.tap: { $stderr ~= $^a };
# We start two Promises: the program to run and a Promise that waits for
# $wait seconds. We await any of them, so if the $wait seconds pass,
# await returns and we follow the path that assumes the code we ran hung.
my $promise = $prog.start;
await $prog.write: $in.encode if $in.defined;
await Promise.anyof: Promise.in(
$wait * $VM-time-scale-multiplier * (%*ENV<ROAST_TIMING_SCALE>//1)
), $promise;
my $did-not-hang = False;
given $promise.status {
when Kept { $did-not-hang = True };
$prog.kill;
}
subtest $desc, {
plan 1 + ( $did-not-hang ?? ($out, $err).grep(*.defined) !! 0 );
ok $did-not-hang, 'program did not hang'
or diag "\nHang in doesn't-hang() test detected by heuristic.\n"
~ "You can set \%*ENV<ROAST_TIMING_SCALE> to a value higher than 1\n"
~ "to make it wait longer.\n";
if $did-not-hang {
cmp-ok $stdout, '~~', $out, 'STDOUT' if $out.defined;
cmp-ok $stderr, '~~', $err, 'STDERR' if $err.defined;
}
};
}
sub make-rand-path (--> IO::Path:D) {
my $p = $*TMPDIR;
$p.resolve.child: (
'perl6_roast_',
$*PROGRAM.basename, '_line',
((try callframe(3).code.line)||''), '_',
rand,
time,
).join.subst: :g, /\W/, '_';
}
my @FILES-FOR-make-temp-file;
my @DIRS-FOR-make-temp-dir;
END {
unlink @FILES-FOR-make-temp-file;
rmdir @DIRS-FOR-make-temp-dir;
}
sub make-temp-path(|c) is export { make-temp-file |c }
sub make-temp-file
(:$content where Any:U|Blob|Cool, Int :$chmod --> IO::Path:D) is export
{
@FILES-FOR-make-temp-file.push: my \p = make-rand-path;
with $chmod { p.spurt: $content // ''; p.chmod: $_ }
orwith $content { p.spurt: $_ }
p
}
sub make-temp-dir (Int $chmod? --> IO::Path:D) is export {
@DIRS-FOR-make-temp-dir.push: my \p = make-rand-path;
p.mkdir;
p.chmod: $_ with $chmod;
p
}
sub has-symbols(%stash, @expected, Str:D $desc) is export {
subtest $desc, {
plan 2;
my @unknown;
my @missing;
my %expected = @expected.map: * => 1;
@unknown.push($_) unless %expected{$_}:exists for %stash.keys;
@missing.push($_) unless %stash{$_}:exists for %expected.keys;
diag "Found {+@unknown} unexpected entries: { @unknown.sort }" if @unknown;
diag "Missing {+@missing} expected entries: { @missing.sort }" if @missing;
ok @unknown == 0, "No unexpected entries";
ok @missing == 0, "No missing entries";
}
}
=begin pod
=head2 group-of
group-of (Pair (Int:D :key($plan), Pair :value((Str:D :key($desc), :value(&tests)))))
A more concise way to write subtests. Code:
group-of 42 => 'some feature' => {
ok 1;
ok 2;
...
ok 42;
}
Is equivalent to:
subtest 'some feature' => {
plan 42;
ok 1;
ok 2;
...
ok 42;
}
=head2 is-run
sub is-run (
Str() $code, $desc = "$code runs",
Stringy :$in, :@compiler-args, :@args, :$out = '', :$err = '', :$exitcode = 0
)
Runs code with C<Proc::Async>, smartmatching STDOUT with C<$out>,
STDERR with C<$err> and exit code with C<$exitcode>. C<$in> can be a C<Str>
or a C<Blob>. C<@args> are arguments to the program, while C<@compiler-args>
are arguments to the compiler.
=head2 is-run-repl
multi sub is-run-repl ($code, $out, $desc, |c)
multi sub is-run-repl ($code, $desc, :$out = '', :$err = '', :$line-editor = 'none')
Fires up the REPL and feeds it with C<$code>, setting
C«%*ENV<RAKUDO_LINE_EDITOR>» to the value of C<$line-editor> for the duration
of the test. If C<$code> is a C<Positional>
or a C<Seq>, will join each element with a C<"\n">. The C<$out> and C<$err>
test STDOUT and STDERR respectively and can be of the following types:
Str: uses `is` test
Regex: uses `like` test
Callable: executes, giving string to test as argument, truthy value means pass
Positional or Seq: assumes to be a list of lines. Joins with "\n", appends
another "\n" to the end and uses `is` test
It's possible to scrub STDOUT of unwanted strings before testing by setting
C<$*REPL-SCRUBBER> to a C<Callable> that takes original STDOUT as argument and
returns the scrubbed version.
Note: the routine sets C«%*ENV<RAKUDO_ERROR_COLOR>» to C<0>
=head2 doesn't-hang
doesn't-hang 'say "some code"' :out(/'some code'/),
'some code does not hang';
doesn't-hang \(:w, $*EXECUTABLE, '-M', "SomeNonExistentMod"),
:in("say 'output works'\nexit\n"),
:out(/'output works'/),
'REPL with -M with non-existent module';
Uses C<Proc::Async> to execute a potentially-hanging program and kills it after
a specified timeout, if it doesn't surrender peacefully. Collects STDERR
and STDOUT, optional taking regex matchers for additional testing. Takes
the following arguments:
=head3 First positional argument
'say "some code"'
\(:w, $*EXECUTABLE, '-M', "SomeNonExistentMod")
B<Mandatory.> Can be a C<Capture> or a C<Str>. A C<Capture> represents
arguments to pass to C<Proc::Async.new()>. If C<Str> is passed, it is treated
as if a capture with C<\($*EXECUTABLE, '-e', $code-to-run)> passed, where
C<$code-to-run> is the code contained in the passed C<Str>.
=head3 Second positional argument
B<Optional.> Takes a C<Str> for test description. B<Defaults to:>
C<'code does not hang'>
=head3 C<:wait>
B<Optional.> Specifies the amount of time in seconds to wait for the
executed program to finish. B<Defaults to:> C<1.5>
=head3 C<:in>
B<Optional>. Takes a C<Str> that will be sent to executed program's STDIN.
B<By default> not specified.
=head3 C<:out>
B<Optional>. Takes a C<.defined> object that will be smartmatched against
C<Str> containing program's STDOUT. If the program doesn't finish before
C<:wait> seconds, no attempt to check STDOUT will be made. B<By default>
not specified.
=head3 C<:err>
B<Optional>. Takes a C<.defined> object that will be smartmatched against
C<Str> containing program's STDERR. If the program doesn't finish before
C<:wait> seconds, no attempt to check STDERR will be made. B<By default>
not specified.
=head2 make-temp-file(:$content, :$chmod)
sub make-temp-file(:$content where Blob|Cool, Int :$chmod --> IO::Path:D)
Creates a semi-random path in C<$*TMPDIR>, optionally setting C<$chmod> and
spurting C<$content> into it. If C<$chmod> is set, but C<$content> isn't,
spurts an empty string. Automatically deletes the file with C<END> phaser.
=head2 make-temp-path(:$content, :$chmod)
Alias for C<make-temp-file>
=head2 make-temp-dir($chmod?)
sub make-temp-dir (Int $chmod? --> IO::Path:D)
Creates a semi-randomly named directory in C<$*TMPDIR>, optionally setting
C<$chmod>, and returns an C<IO::Path> pointing to it. Automatically
C<rmdir>s it with C<END> phaser. It's your responsibility to ensure the
directory is empty at that time.
=end pod