Add a 'fix' to work around the Test::Harness bug. Disclaimer: The wor…

…karound is evil. overwrite the harness with the new kakapo-based one.
Whiteknight · Mar 19, 2010 · 023e585 · 023e585
1 parent 25242d3
commit 023e585
Show file tree

Hide file tree

Showing 6 changed files with 90 additions and 64 deletions.
diff --git a/t/harness b/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();
 
@@ -10,45 +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;
+    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 @ARGS {
+    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
+        $test_output.shift;  # we don't need the plan anymore
 
-        for $output {
+        for $test_output {
             my $line := $_;
 
             if ( $line ) {
 
-                my $line_parts := split('ok ', $line);
+                my $line_parts := $line.split("ok ");
                 my $right_side := $line_parts[1];
-                my $right_side_parts := split(' ', $right_side);
+                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 ') {
@@ -61,32 +59,82 @@ sub MAIN () {
             }
         }
         if $failed {
-            say('failed ' ~ $failed ~ '/' ~ $num_tests ~ ' tests');
+            pir::say('failed ' ~ $failed ~ '/' ~ $num_tests ~ ' tests');
         }
         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('passed ' ~ $curr_test ~ ' tests');
             }
         }
         $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));
+    $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
+    };
+}
diff --git a/t/harness2 b/t/harness2
@@ -76,6 +76,7 @@ sub MAIN () {
             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));
@@ -128,3 +129,12 @@ sub run_test($filename) {
     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
+    };
+}
diff --git a/t/pmc/charmatrix2d.t b/t/pmc/charmatrix2d.t
@@ -1,11 +1,3 @@
-#! parrot-nqp
-
-INIT {
-    pir::load_bytecode('./library/kakapo_full.pbc');
-    pir::loadlib__ps("./linalg_group");
-    Nqp::compile_file('t/testlib/matrixtest.nqp');
-}
-
 class Test::CharMatrix2D is Pla::Matrix::Testcase;
 
 INIT {

diff --git a/t/pmc/complexmatrix2d.t b/t/pmc/complexmatrix2d.t
@@ -1,11 +1,3 @@
-#! parrot-nqp
-
-INIT {
-    pir::load_bytecode('./library/kakapo_full.pbc');
-    pir::loadlib__ps("./linalg_group");
-    Nqp::compile_file('t/testlib/matrixtest.nqp');
-}
-
 class Test::ComplexMatrix2D is Pla::Matrix::Testcase;
 
 INIT {

diff --git a/t/pmc/nummatrix2d.t b/t/pmc/nummatrix2d.t
@@ -1,12 +1,4 @@
-#! parrot-nqp
-
-INIT {
-    pir::load_bytecode('./library/kakapo_full.pbc');
-    pir::loadlib__ps("./linalg_group");
-    Nqp::compile_file('t/testlib/matrixtest.nqp');
-}
-
-class Test::CharMatrix2D is Pla::Matrix::Testcase;
+class Test::NumMatrix2D is Pla::Matrix::Testcase;
 
 INIT {
     use('UnitTest::Testcase');

diff --git a/t/pmc/pmcmatrix2d.t b/t/pmc/pmcmatrix2d.t
@@ -1,12 +1,4 @@
-#! parrot-nqp
-
-INIT {
-    pir::load_bytecode('./library/kakapo_full.pbc');
-    pir::loadlib__ps("./linalg_group");
-    Nqp::compile_file('t/testlib/matrixtest.nqp');
-}
-
-class Test::CharMatrix2D is Pla::Matrix::Testcase;
+class Test::PmcMatrix2D is Pla::Matrix::Testcase;
 
 INIT {
     use('UnitTest::Testcase');