Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
start reworking the test suite to use Kakapo.
  • Loading branch information
Whiteknight committed Mar 22, 2010
1 parent c4f7d37 commit a8634e1
Show file tree
Hide file tree
Showing 5 changed files with 198 additions and 363 deletions.
113 changes: 81 additions & 32 deletions t/harness
@@ -1,6 +1,9 @@
#! parrot-nqp

our @ARGS;
INIT {
pir::load_bytecode('./library/kakapo_full.pbc');
#Nqp::compile_file('t/testlib/matrixtest.nqp');
}

MAIN();

Expand All @@ -10,44 +13,40 @@ MAIN();
# verbose mode

sub MAIN () {
pir::load_bytecode('t/Glue.pbc');
my $total_passed:= 0;
my $total_failed:= 0;
my $total_files := 0;
my $failed_files:= 0;

for @ARGS {
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);

print($filename ~ '...');

my $file := slurp($_);
my $test_output := qx('parrot-nqp', $filename);
my $output := split("\n",$test_output);
my @plan_parts := split('..',$output[0]);

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;

$output.shift; # we don't need the plan anymore

for $output {
$test_output.shift; # we don't need the plan anymore

for $test_output {
my $line := $_;

if ( $line ) {

my $line_parts := split('ok ',$line);
my $test_number:= $line_parts[1];
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 := split(' -',$test_number);
my @test_num_parts := $test_number.split(' -');
$test_number := @test_num_parts[0];
}
if ($line_parts[0] eq 'not ') {
Expand All @@ -60,32 +59,82 @@ sub MAIN () {
}
}
if $failed {
say('failed ' ~ $failed ~ '/' ~ $num_tests ~ ' tests');
pir::say('not ok (' ~ $failed ~ '/' ~ $num_tests ~ ' failed)');
}
else {
if @plan_parts[0] != 1 || $num_tests < 0 {
say('INVALID PLAN: ' ~ join('',@plan_parts));
pir::say('INVALID PLAN: ' ~ @plan_parts.join());
$failed_files++;
}
else {
say('passed ' ~ $curr_test ~ ' tests');
pir::say('ok');
}
}
$total_passed := $total_passed + $passed;
$total_failed := $total_failed + $failed;
if $num_tests != $curr_test {
say("Planned to run " ~ $num_tests ~ " tests but ran " ~ $curr_test ~ " tests");
say("FAILED");
pir::say("Planned to run " ~ $num_tests ~ " tests but ran " ~ $curr_test ~ " tests");
pir::say("FAILED");
}
reset_test_environment();
}
if $total_failed {
say("FAILED " ~ $total_failed ~ '/' ~ ($total_passed+$total_failed));
pir::say("FAILED " ~ $total_failed ~ '/' ~ ($total_passed+$total_failed));
Q:PIR {
exit 1
}
} elsif $failed_files {
say("FAILED " ~ $failed_files ~ " files, PASSED " ~ $total_passed ~ ' tests');
pir::say("FAILED " ~ $failed_files ~ " files, PASSED " ~ $total_passed ~ ' tests');
} else {
say("PASSED " ~ $total_passed ~ ' tests in ' ~ $total_files ~ ' files');
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
};
}

0 comments on commit a8634e1

Please sign in to comment.