/
harness
140 lines (124 loc) · 4.22 KB
/
harness
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
#! parrot-nqp
INIT {
pir::load_bytecode('./library/kakapo_full.pbc');
#Nqp::compile_file('t/testlib/matrixtest.nqp');
}
MAIN();
# TAP grammar in ABNF
# http://testanything.org/wiki/index.php/TAP_at_IETF:_Draft_Standard#Grammar
# TODO:
# verbose mode
sub MAIN () {
my $total_passed := 0;
my $total_failed := 0;
my $total_files := 0;
my $failed_files := 0;
my $max_length := 30;
my @files := get_all_tests("t", "t/pmc");
for @files {
my $filename := $_;
$total_files++;
print_filename($filename, $max_length);
my $test_output := run_test($filename);
my $plan := $test_output[0];
my @plan_parts := $plan.split('..');
my $num_tests := @plan_parts[1];
my $curr_test := 0;
my $passed := 0;
my $failed := 0;
$test_output.shift; # we don't need the plan anymore
for $test_output {
my $line := $_;
if ( $line ) {
my $line_parts := $line.split("ok ");
my $right_side := $line_parts[1];
my $right_side_parts := $right_side.split(' ');
my $test_number := $right_side_parts[0];
# strip out comments
unless ($test_number > 0) {
my @test_num_parts := $test_number.split(' -');
$test_number := @test_num_parts[0];
}
if ($line_parts[0] eq 'not ') {
$failed++;
$curr_test++;
} elsif ($test_number == ($curr_test+1)) {
$passed++;
$curr_test++;
}
}
}
if $failed {
pir::say('not ok (' ~ $failed ~ '/' ~ $num_tests ~ ' failed)');
}
else {
if @plan_parts[0] != 1 || $num_tests < 0 {
pir::say('INVALID PLAN: ' ~ @plan_parts.join());
$failed_files++;
}
else {
pir::say('ok');
}
}
$total_passed := $total_passed + $passed;
$total_failed := $total_failed + $failed;
if $num_tests != $curr_test {
pir::say("Planned to run " ~ $num_tests ~ " tests but ran " ~ $curr_test ~ " tests");
pir::say("FAILED");
}
reset_test_environment();
}
if $total_failed {
pir::say("FAILED " ~ $total_failed ~ '/' ~ ($total_passed+$total_failed));
Q:PIR {
exit 1
}
} elsif $failed_files {
pir::say("FAILED " ~ $failed_files ~ " files, PASSED " ~ $total_passed ~ ' tests');
} else {
pir::say("PASSED " ~ $total_passed ~ ' tests in ' ~ $total_files ~ ' files');
}
}
sub get_all_tests(*@dirs) {
my $fs := FileSystem.instance;
my @files := Parrot::new("ResizableStringArray");
for @dirs {
my $dir := $_;
my @rawfiles := $fs.get_contents($dir);
for @rawfiles {
my $filename := $_;
if pir::index__ISS($filename, ".t") != -1 {
@files.push($dir ~ "/" ~ $filename);
my $length := pir::length__IS($dir ~ "/" ~ $filename);
#if $length > $max_length {
# $max_length := $length;
#}
}
}
}
return (@files);
}
sub print_filename($filename, $max_length) {
my $length := pir::length__IS($filename);
my $diff := ($max_length - $length) + 3;
my $elipses := pir::repeat__SSI('.', $diff);
print($filename ~ " " ~ $elipses ~ " ");
}
sub run_test($filename) {
my $sub := Nqp::compile_file($filename);
my $stdout := Parrot::new("StringHandle");
$stdout.open("blah", "rw");
my %save_handles := Program::swap_handles(:stdout($stdout), :stderr($stdout));
$sub[0]();
Program::swap_handles(|%save_handles);
return ($stdout.readall().split("\n"));
}
sub reset_test_environment() {
# TODO: This is an evil hack. Test::Builder doesn't clean up it's environment
# so when I try to run multiple tests in a single program instance
# it breaks. When Test::Builder gets fixed, remove this nonsense
Q:PIR {
$P0 = new "Undef"
set_hll_global [ 'Test'; 'Builder'; '_singleton' ], 'singleton', $P0
};
}