Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 97 lines (75 sloc) 2.453 kB
cdf370e [t/spec] add Test::Util (which needs more work)
kyle authored
1 module Test::Util;
2
3 # XXX This code hasn't been successfully tested.
4
5 # This seems necessary, and yet it crashes Rakudo.
6 #use Test;
7
8 # is_run 'say "hello"', { status => 0, out => "hello\n", err => '' }, 'say hello';
9
10 multi sub is_run( Str $code, Str $input, %expected, Str $name ) is export(:DEFAULT) {
11 my %got = get_out( $code, $input // '' );
12
13 # The test wasn't executed because the collection of kluges died.
14 if %got<test_died> {
15 skip 1, %got<test_died>;
16 }
17
18 my $ok = ?1;
19 my $tests_aggregated = 0;
20
21 for <status out err> -> $attr {
22 # Attributes not specified are not tested.
23 next if ! %expected.exists( $attr );
24
25 my $attr_good;
26 given %expected{$attr} {
27 when Regex {
28 $attr_good = %got{$attr} ~~ %expected{$attr};
29 }
30 when Callable {
31 $attr_good = %expected{$attr}( %got{$attr} );
32 }
33 default {
34 $attr_good = %got{$attr} eq %expected{$attr};
35 }
36 }
37
38 if !$attr_good {
39 diag " got $attr: {%got{$attr}}";
40 diag "expected $attr: {%expected{$attr}}";
41 }
42
43 $ok &&= $attr_good;
44 $tests_aggregated++;
45 }
46
47 if $tests_aggregated > 0 {
48 proclaim(?$ok, $name);
49 }
50 else {
51 skip 1, 'nothing tested';
52 }
53 }
54
55 multi sub get_out( Str $code ) {
56 return get_out( $code, '' );
57 }
58
59 multi sub get_out( Str $code, Str $input ) {
60 my $bin = $*EXECUTABLE_NAME;
61
62 my $fnbase = 'getout-';
63 $fnbase ~= try { $*PID } // 1_000.rand.Int;
64
65 my $clobber = sub {
66 my $fh = open $^a, :w
67 or die "Can't create '$^a': $!";
68 $fh.print( $^b );
69 $fh.close or die "close failed: $!";
70 };
71
72 my %out;
73
74 try {
75 $clobber( "$fnbase.in", $input );
76 $clobber( "$fnbase.code", $code );
77
78 %out<status> = run( "$bin $fnbase.code < $fnbase.in > $fnbase.out 2> $fnbase.err" );
79 %out<out> = slurp "$fnbase.out";
80 %out<err> = slurp "$fnbase.err";
81
82 CATCH { %out<test_died> = $! }
83 }
84
85 # Try to delete all the temp files written. If any survive, die.
86 my @files = map { "$fnbase.$_" }, <code in out err>;
87 unlink $_ for @files;
88 for @files -> $f {
89 # TODO: File existence test works in Rakudo but is not current spec
90 if $f ~~ :e {
91 die "Can't unlink '$f'";
92 }
93 }
94
95 return %out;
96 }
Something went wrong with that request. Please try again.