Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 200 lines (146 sloc) 5.886 kb
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
1 module Test::Util;
2
b0e0d11 [t/spec] in Test::Util, use Test; in order to have sub skip() available
moritz authored
3 use Test;
4
6cdf6f9 spruce up Test::Util::is_run
kyle authored
5 # Tests for this testing code may be in the pugs repo under t/03-test-util/
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
6
d8050f5 @jnthn Get Test::Util to export a proto rather than dubiously exporting each…
jnthn authored
7 proto sub is_run(|$) is export(:DEFAULT) { * }
8
6cdf6f9 spruce up Test::Util::is_run
kyle authored
9 # No input, no test name
d8050f5 @jnthn Get Test::Util to export a proto rather than dubiously exporting each…
jnthn authored
10 multi sub is_run( Str $code, %expected, :@args ) {
23c4fd7 [t/spec] make Test::Util accept command line arguments for the progra…
moritz authored
11 return is_run( $code, '', %expected, '', :@args );
6cdf6f9 spruce up Test::Util::is_run
kyle authored
12 }
13
14 # Has input, but not a test name
d8050f5 @jnthn Get Test::Util to export a proto rather than dubiously exporting each…
jnthn authored
15 multi sub is_run( Str $code, Str $input, %expected, :@args ) {
23c4fd7 [t/spec] make Test::Util accept command line arguments for the progra…
moritz authored
16 return is_run( $code, $input, %expected, '', :@args );
6cdf6f9 spruce up Test::Util::is_run
kyle authored
17 }
18
19 # No input, named
d8050f5 @jnthn Get Test::Util to export a proto rather than dubiously exporting each…
jnthn authored
20 multi sub is_run( Str $code, %expected, Str $name, :@args ) {
23c4fd7 [t/spec] make Test::Util accept command line arguments for the progra…
moritz authored
21 return is_run( $code, '', %expected, $name, :@args );
6cdf6f9 spruce up Test::Util::is_run
kyle authored
22 }
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
23
d8050f5 @jnthn Get Test::Util to export a proto rather than dubiously exporting each…
jnthn authored
24 multi sub is_run( Str $code, Str $input, %expected, Str $name, :@args ) {
6e4986e [t/spec] allow -e testing with Test::Util
moritz authored
25 my %got = get_out( $code, $input, :@args );
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
26
6cdf6f9 spruce up Test::Util::is_run
kyle authored
27 # The test may have executed, but if so, the results couldn't be collected.
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
28 if %got<test_died> {
6cdf6f9 spruce up Test::Util::is_run
kyle authored
29 return skip 1, 'test died: ' ~ %got<test_died>;
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
30 }
31
32 my $ok = ?1;
33 my $tests_aggregated = 0;
6cdf6f9 spruce up Test::Util::is_run
kyle authored
34 my @diag_q;
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
35
6cdf6f9 spruce up Test::Util::is_run
kyle authored
36 # We check each of the attributes and pass the test only if all are good.
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
37 for <status out err> -> $attr {
38 # Attributes not specified are not tested.
39 next if ! %expected.exists( $attr );
40
a586cc3 [Test::Util] a little refactor
kyle authored
41 my $attr_good = %got{$attr} ~~ %expected{$attr};
6cdf6f9 spruce up Test::Util::is_run
kyle authored
42
43 # The check for this attribute failed.
44 # Note why for a diag() after the test failure is reported.
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
45 if !$attr_good {
6cdf6f9 spruce up Test::Util::is_run
kyle authored
46 @diag_q.push( " got $attr: {%got{$attr}.perl}" );
a586cc3 [Test::Util] a little refactor
kyle authored
47 if %expected{$attr} ~~ Str|Num {
6cdf6f9 spruce up Test::Util::is_run
kyle authored
48 @diag_q.push( "expected $attr: {%expected{$attr}.perl}" );
49 }
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
50 }
51
45e353c [Test::Util] further simplification; now runs on Rakudo
moritz authored
52 $ok = $ok && $attr_good;
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
53 $tests_aggregated++;
54 }
55
6cdf6f9 spruce up Test::Util::is_run
kyle authored
56 if $tests_aggregated == 0 {
57 return skip 1, 'nothing tested';
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
58 }
59
6cdf6f9 spruce up Test::Util::is_run
kyle authored
60 ok ?$ok, $name;
61 diag $_ for @diag_q;
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
62
6cdf6f9 spruce up Test::Util::is_run
kyle authored
63 return;
64 }
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
65
23c4fd7 [t/spec] make Test::Util accept command line arguments for the progra…
moritz authored
66 sub get_out( Str $code, Str $input?, :@args) is export {
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
67 my $fnbase = 'getout-';
6cdf6f9 spruce up Test::Util::is_run
kyle authored
68 $fnbase ~= $*PID // 1_000_000.rand.Int;
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
69
a3b6474 [Test::Util] simplify code a bit
moritz authored
70 my $clobber = sub ($a, $b) {
71 my $fh = open $a, :w
72 or die "Can't create '$a': $!";
73 $fh.print( $b );
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
74 $fh.close or die "close failed: $!";
75 };
76
23c4fd7 [t/spec] make Test::Util accept command line arguments for the progra…
moritz authored
77 my @actual_args;
37e2c73 Fix quoting command line args on windows moritz_++
patrickas authored
78 my $sep = q['];
79 $sep = q["] if $*OS ~~ /:i win/;
23c4fd7 [t/spec] make Test::Util accept command line arguments for the progra…
moritz authored
80 for @args {
81 if /<['"]>/ {
82 die "Command line arguments may not contain single or double quotes";
83 }
84 @actual_args.push: $sep ~ $_ ~ $sep;
85 }
86
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
87 my %out;
88
89 try {
6e4986e [t/spec] allow -e testing with Test::Util
moritz authored
90 $clobber( "$fnbase.in", $input );
91 $clobber( "$fnbase.code", $code ) if defined $code;
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
92
6cdf6f9 spruce up Test::Util::is_run
kyle authored
93 my $perl6 = $*EXECUTABLE_NAME;
94
2d3caf3 [Test::Util] reunite lonely variable with its purpose
kyle authored
95 my $cmd = "$perl6 ";
6e4986e [t/spec] allow -e testing with Test::Util
moritz authored
96 $cmd ~= $fnbase ~ '.code' if $code.defined;
97 $cmd ~= " @actual_args.join(' ') < $fnbase.in > $fnbase.out 2> $fnbase.err";
98 # diag("Command line: $cmd");
143c569 @moritz track spec change: &run -> &shell
moritz authored
99 %out<status> = shell( $cmd );
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
100 %out<out> = slurp "$fnbase.out";
101 %out<err> = slurp "$fnbase.err";
102
6cdf6f9 spruce up Test::Util::is_run
kyle authored
103 CATCH { %out<test_died> = ~$! }
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
104 }
105
106 # Try to delete all the temp files written. If any survive, die.
107 my @files = map { "$fnbase.$_" }, <code in out err>;
108 unlink $_ for @files;
109 for @files -> $f {
20f1e14 [t/spec] switch to .IO form of file tests
moritz authored
110 if $f.IO ~~ :e {
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
111 die "Can't unlink '$f'";
112 }
113 }
114
115 return %out;
116 }
6cdf6f9 spruce up Test::Util::is_run
kyle authored
117
b72bda7 [Test::Util] fix obsolete pod
kyle authored
118 =begin pod
6cdf6f9 spruce up Test::Util::is_run
kyle authored
119
120 =head1 NAME
121
122 Test::Util - Extra utility code for testing
123
124 =head1 SYNOPSIS
125
126 use Test;
127 use Test::Util;
128
129 is_run( 'say $*IN.lines', # code to run
130 'GIGO', # input for code
131 { out => "GIGO\n", err => '', status => 0 }, # results expected
132 'input comes back out' ); # test name
133
134 =head1 DESCRIPTION
135
136 This module is for test code that would be useful
137 across Perl 6 implementations.
138
139 =head1 FUNCTIONS
140
141 =head2 is_run( Str $code, Str $input?, %wanted, Str $name? )
142
143 It runs the code given, feeding it the input given, and collects results
144 in the form of its stdout, stderr, and exit status. The %wanted hash
145 specifies which of these to check and what to check them against.
146 Every item in the hash must "match" for the is_run() test to pass.
147 For example:
148
149 {
150 out => "Hello world!\n", # outputs Hello world!
151 err => '', # no error output
152 status => 0, # standard successful exit
153 },
154
155 Any of those items not present in the %wanted hash will not be tested
156 (that is, the test passes regardless of the results of those items).
157 For example, if 'status' is not specified, the test passes regardless
158 of what the code's exit status was.
159
160 Each item can be a string, a Regexp, or a Callable. Strings must match
161 exactly.
162
163 A Callable is passed the result, and the test passes
164 if the Callable returns a true value.
165 For example:
166
167 is_run( 'rand.say', { out => sub { $^a > 0 && $^a < 1 }, err => '' },
168 'output of rand is between zero and one' );
169
170 =head3 Errors
171
172 If the underlying code could not be executed properly (e.g., because
173 temp files could not be accessed), is_run() will skip().
174
175 If the %wanted hash passed in does not contain any of the items it checks,
176 is_run() will skip() (but it will still execute the code not being tested).
177
178 is_run() depends on get_out(), which might die. In that case, it dies
179 also (this error is not trapped).
180
23c4fd7 [t/spec] make Test::Util accept command line arguments for the progra…
moritz authored
181 =head2 get_out( Str $code, Str $input?, :@args )
6cdf6f9 spruce up Test::Util::is_run
kyle authored
182
183 This is what is_run() uses to do its work. It returns a hash with the
184 'status', 'err', and 'out' of the code run. In addition, if the hash
185 it returns has an element named 'test_died', that means it failed to
186 either run the code or collect the results. Any other elements of the
187 hash should be disregarded.
188
23c4fd7 [t/spec] make Test::Util accept command line arguments for the progra…
moritz authored
189 C<:@args> can contain command line arguments passed to the program.
190 They may not contain quote characters, or get_out will complain loudly.
191
6cdf6f9 spruce up Test::Util::is_run
kyle authored
192 =head3 Errors
193
194 This will die if it can't clean up the temp files it uses to do its work.
195 All other errors should be trapped and reported via the 'test_died' item.
196
b72bda7 [Test::Util] fix obsolete pod
kyle authored
197 =end pod
8ac5de0 [t/spec] simplify Test::Util to use smart-matching more generally
moritz authored
198
199 # vim: ft=perl6
Something went wrong with that request. Please try again.