[t] Plumage gets to be the first kid on the block to use the Tapir te…

…st harness

Tapir is just three PIR files, t/harness.pir and two libraries in
ext/Tapir/. A PBC or fakecutable for Tapir could be generated, but it
complicates the build process for no good reason. The make target for
'test' now invokes Tapir and there is now also a 'testv' target which is
verbose, i.e. prints out all TAP output.

In theory, we could add the Tapir git repo as a git submodule, but the current
setup is the simplest possible setup that could work.

ext/Tapir/Parser.pir

@@ -0,0 +1,132 @@
+# Copyright (C) 2009, Jonathan "Duke" Leto
+
+=head1 AUTHOR
+
+Written and maintained by Jonathan "Duke" Leto C<< jonathan@leto.net >>.
+
+=cut
+
+.namespace [ 'Tapir'; 'Parser' ]
+
+.sub parse_tapstream :method
+    .param string tap
+    .param int exit_code :optional
+    .local string curr_line
+    .local pmc plan, pass, fail, skip, todo
+    .local int i, curr_test, reported_test
+    .local pmc tap_lines, parts, klass, stream
+
+    i         = 0
+    curr_test = 1
+    fail      = new 'Integer'
+    skip      = new 'Integer'
+    todo      = new 'Integer'
+    pass      = new 'Integer'
+    plan      = new 'Integer'
+    tap_lines = new 'ResizablePMCArray'
+    parts     = new 'ResizablePMCArray'
+
+    split tap_lines, "\n", tap
+    $I0 = tap_lines
+
+    .local string plan_line
+    plan_line = tap_lines[0]
+    plan      = self.'parse_plan'(plan_line)
+
+    .local string prefix
+  loop:
+    if i >= $I0 goto done
+    curr_line = tap_lines[i]
+
+    split parts, "ok ", curr_line
+
+    prefix        = parts[0]
+    reported_test = parts[1]
+
+    if prefix == 'not ' goto fail_or_todo
+
+    if reported_test == curr_test goto pass_or_skip
+
+    # it was an unrecognized line
+    inc i
+    goto loop
+  pass_or_skip:
+    split parts, "# ", curr_line
+    $S0 = parts[1]
+    $S0 = substr $S0, 0, 4
+    downcase $S0
+    if $S0 != "skip" goto passz
+    # it is a SKIP test!
+    inc skip
+    inc i
+    inc curr_test
+    goto loop
+  fail_or_todo:
+    split parts, "# ", curr_line
+    $S0 = parts[1]
+    $S0 = substr $S0, 0, 4
+    downcase $S0
+    if $S0 != "todo" goto failz
+    # it is a TODO test!
+    inc todo
+    inc curr_test
+    inc i
+    goto loop
+  failz:
+    inc fail
+    inc curr_test
+    inc i
+    goto loop
+  passz:
+    inc pass
+    inc i
+    inc curr_test
+    goto loop
+
+  done:
+    stream = new [ 'Tapir'; 'Stream' ]
+    stream.'set_pass'(pass)
+    stream.'set_fail'(fail)
+    stream.'set_todo'(todo)
+    stream.'set_skip'(skip)
+    stream.'set_plan'(plan)
+    stream.'set_exit_code'(exit_code)
+    .return (stream)
+.end
+
+# parse_plan returns the expected number of test given a TAP stream as a string
+
+.sub parse_plan :method
+    .param string plan_line
+    .local pmc plan_parts
+    # yes, a numeric
+    .local num num_expected_tests
+
+    $I0 = length plan_line
+    if $I0 < 4 goto plan_error
+
+    # this needs to take into account TAP Versions
+    $S0 = substr plan_line, 0, 3
+    unless $S0 == "1.." goto plan_error
+
+    plan_parts = new 'FixedPMCArray'
+    plan_parts = 2
+
+    split plan_parts, "..", plan_line
+    num_expected_tests  = plan_parts[1]
+
+    $I1 = num_expected_tests
+    unless $I1 == num_expected_tests goto plan_error
+    .return (num_expected_tests)
+  plan_error:
+    # this indicates an invalid plan
+    .return (-1)
+.end
+
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+

ext/Tapir/Stream.pir

@@ -0,0 +1,129 @@
+# Copyright (C) 2009, Jonathan "Duke" Leto <jonathan@leto.net>
+
+.namespace [ 'Tapir'; 'Stream' ]
+
+# 06:28:33 <@chromatic> :load executes only when loading from bytecode.
+# 06:28:48 <@chromatic> :init executes right after compilation.
+# 06:29:17 <@chromatic> The effects of :init should be frozen into PBC.
+# 06:37:26 <@chromatic> :anon :init trips the "Do something special with bytecode" magic.
+
+.sub _initialize :load :anon
+    .local pmc klass
+
+    klass  = newclass [ 'Tapir'; 'Stream' ]
+    klass.'add_attribute'('pass')
+    klass.'add_attribute'('fail')
+    klass.'add_attribute'('skip')
+    klass.'add_attribute'('todo')
+    klass.'add_attribute'('plan')
+    klass.'add_attribute'('exit_code')
+.end
+
+.sub is_pass :method
+    .local pmc fail
+    fail = getattribute self, "fail"
+    if fail goto failz
+
+    .local pmc exit_code
+    exit_code = self."get_exit_code"()
+    if exit_code goto failz
+
+    .local pmc skip, pass, todo, plan
+    skip  = self."get_skip"()
+    pass  = self."get_pass"()
+    todo  = self."get_todo"()
+    plan  = self."get_plan"()
+    $P0   = pass + todo
+    $P0  += skip
+
+    $I1 = plan == $P0
+    .return( $I1 )
+  failz:
+    .return( 0 )
+.end
+
+.sub set_exit_code :method
+    .param pmc exit_code
+    setattribute self, "exit_code", exit_code
+.end
+
+.sub set_pass :method
+    .param pmc pass
+    setattribute self, "pass", pass
+.end
+
+.sub set_fail :method
+    .param pmc fail
+    setattribute self, "fail", fail
+.end
+
+.sub set_todo :method
+    .param pmc todo
+    setattribute self, "todo", todo
+.end
+
+.sub set_skip :method
+    .param pmc skip
+    setattribute self, "skip", skip
+.end
+
+.sub set_plan :method
+    .param pmc plan
+    setattribute self, "plan", plan
+.end
+
+.sub get_exit_code :method
+    .local pmc exit_code
+    exit_code = getattribute self, "exit_code"
+    .return( exit_code )
+.end
+
+.sub get_pass :method
+    .local pmc pass
+    pass = getattribute self, "pass"
+    .return( pass )
+.end
+
+.sub get_fail :method
+    .local pmc fail
+    fail = getattribute self, "fail"
+    .return( fail )
+.end
+
+.sub get_todo :method
+    .local pmc todo
+    todo = getattribute self, "todo"
+    .return( todo )
+.end
+
+.sub get_skip :method
+    .local pmc skip
+    skip = getattribute self, "skip"
+    .return( skip )
+.end
+
+.sub get_plan :method
+    .local pmc plan
+    plan = getattribute self, "plan"
+    .return( plan )
+.end
+
+.sub total :method
+    .local pmc skip, pass, fail, todo
+    skip = getattribute self, "skip"
+    pass = getattribute self, "pass"
+    fail = getattribute self, "fail"
+    todo = getattribute self, "todo"
+    $P0  = pass + fail
+    $P0 += todo
+    $P0 += skip
+    .return( $P0 )
+.end
+
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+

src/Makefile.in

@@ -67,7 +67,11 @@ clean: FORCE
 	        "src/*.c" "src/*$(O)" src/plumage$(EXE) plumage$(EXE) Makefile
 
 test: FORCE all
-	$(PARROT_NQP) t/harness t/*.t
+	$(PARROT) t/harness.pir --exec=$(PARROT_NQP) t/*.t
+
+testv: FORCE all
+	$(PARROT) t/harness.pir --verbose --exec=$(PARROT_NQP) t/*.t
+
 
 # Local variables:
 #   mode: makefile