[t] Plumage gets to be the first kid on the block to use the Tapir test harness
[parrot-plumage:parrot-plumage.git] / t / harness
1 #! parrot-nqp
2
3 # Test harness written in NQP (the newer nqp-rx flavor)
4 # by Jonathan "Duke" Leto http://leto.net
5
6 # The current canonical home for this harness is Parrot Plumage  http://gitorious.org/parrot-plumage
7 # Please make changes to this script in the Plumage repo
8
9 my $*EXECUTABLE_NAME;
10 my @*ARGS;
11 pir::exit(MAIN());
12
13 # TAP grammar in ABNF
14 # http://testanything.org/wiki/index.php/TAP_at_IETF:_Draft_Standard#Grammar
15
16 # TODO:
17 # verbose mode
18
19 sub MAIN () {
20     pir::load_bytecode('src/lib/Glue.pbc');
21     pir::load_bytecode('src/lib/Util.pbc');
22
23     my $total_passed:= 0;
24     my $total_failed:= 0;
25     my $total_files := 0;
26     my $failed_files:= 0;
27
28     for @*ARGS {
29         my $filename := $_;
30         $total_files++;
31
32         print("$filename ...");
33
34         my $test_output := qx($*EXECUTABLE_NAME, $filename);
35         my $output      := pir::split("\n",$test_output);
36         my @plan_parts  := pir::split('..',$output[0]);
37
38         my $num_tests   := @plan_parts[1];
39         my $curr_test   := 0;
40         my $passed      := 0;
41         my $failed      := 0;
42
43         $output.shift;  # we don't need the plan anymore
44
45         for $output {
46             my $line := $_;
47             if ( $line ) {
48                 my $line_parts := pir::split('ok ',$line);
49                 my $test_number:= $line_parts[1];
50
51                 # strip out comments
52                 unless ($test_number > 0) {
53                     my @test_num_parts := pir::split(' -',$test_number);
54                     $test_number       := @test_num_parts[0];
55                 }
56
57                 if ($line_parts[0] eq 'not ') {
58                     $failed++;
59                     $curr_test++;
60                 } elsif ($test_number == ($curr_test+1)) {
61                     $passed++;
62                     $curr_test++;
63                 }
64             }
65         }
66         if ($failed) {
67             say("failed $failed/$num_tests tests");
68         } elsif ( @plan_parts[0] != 1 || $num_tests < 0) {
69             say('INVALID PLAN: ', @plan_parts );
70             $failed_files++;
71         } else {
72             say("passed $curr_test tests");
73         }
74         $total_passed := $total_passed + $passed;
75         $total_failed := $total_failed + $failed;
76
77         if ( $num_tests != $curr_test ) {
78             say("Planned to run $num_tests tests but ran $curr_test tests");
79             say("FAILED");
80         }
81     }
82     if ($total_failed) {
83         say("FAILED  $total_failed/",($total_passed+$total_failed));
84         return 1;
85     } elsif ($failed_files) {
86         say("FAILED $failed_files files, PASSED $total_passed tests");
87         return 1;
88     } else {
89         say("PASSED $total_passed tests in $total_files files");
90         return 0;
91     }
92 }