Author: chromatic
Date: Sat Jul 30 19:48:10 2005
New Revision: 8752

Added:
   trunk/runtime/parrot/library/Test/
   trunk/runtime/parrot/library/Test/Builder/
   trunk/runtime/parrot/library/Test/Builder.pir
   trunk/runtime/parrot/library/Test/Builder/Output.pir
   trunk/runtime/parrot/library/Test/Builder/Test.pir
   trunk/runtime/parrot/library/Test/Builder/TestPlan.pir
Log:
Initial checkin of Test::Builder port to Parrot.
This works in informal tests; I'll add a Test::Builder::Tester port to be sure.


Added: trunk/runtime/parrot/library/Test/Builder.pir
==============================================================================
--- (empty file)
+++ trunk/runtime/parrot/library/Test/Builder.pir       Sat Jul 30 19:48:10 2005
@@ -0,0 +1,614 @@
+=head1 NAME
+
+Test::Builder - Parrot extension for building test modules
+
+=head1 SYNOPSIS
+
+       # load this library
+       load_bytecode 'library/Test/Builder.pir'
+
+       # create a new Test::Builder object
+       .local pmc test
+       .local int test_type
+
+       find_type test_type, 'Test::Builder'
+       test = new test_type
+
+       # plan to run ten tests
+       test.'plan'( 10 )
+
+       test.'ok'( 1, 'some test description' )
+       test.'ok'( 0, 'some test description' )
+       test.'diag'( 'the last test failed on purpose!' )
+
+       test.'skip'( 3, 'do not run these three tests' )
+       test.'todo'( 1, 'this is a todo test that passes', 'i am not sure' )
+       test.'todo'( 0, 'this is a todo test that fails', ' i am still not 
sure' )
+
+       test.'skip'( 4, 'cannot think of four more tests' )
+
+       # you must call this when you have finished!
+       test.'finish'()
+
+=head1 DESCRIPTION
+
+Test::Builder is a pure-Parrot library for building test modules.  It manages
+test plans, formats and reports test results correctly, and has methods to
+manage passing, failing, skip, and TODO tests.  It provides a simple, single
+backend for multiple test modules to use within your tests.
+
+=head1 METHODS
+
+This class defines the following methods:
+
+=over 4
+
+=cut
+
+.namespace [ 'Test::Builder' ]
+
+.sub _initialize @LOAD
+       load_bytecode 'library/Test/Builder/Test.pir'
+       load_bytecode 'library/Test/Builder/Output.pir'
+       load_bytecode 'library/Test/Builder/TestPlan.pir'
+
+       .local pmc tb_class
+
+       newclass     tb_class, 'Test::Builder'
+       addattribute tb_class, 'output'
+       addattribute tb_class, 'testplan'
+       addattribute tb_class, 'results'
+
+       .local pmc output
+       .local pmc testplan
+       .local pmc results
+
+       output   = new .Undef
+       testplan = new .Undef
+       results  = new .Undef
+
+       store_global 'Test::Builder::_singleton',   'output',   output
+       store_global 'Test::Builder::_singleton', 'testplan', testplan
+       store_global 'Test::Builder::_singleton',  'results',  results
+.end
+
+=item C<new( args_hash )>
+
+Given an optional C<Hash> of arguments, initializes the new object with the
+provided arguments.  By default, you should rarely need to pass any arguments.
+If you do, you know why.  The two allowed arguments are:
+
+=over 4
+
+=item C<testplan>
+
+An object that C<does> C<Test::Builder::TestPlan> to manage the plan for this
+test run.
+
+=item C<output>
+
+An object that does C<Test::Builder::Output> to manage the output for this test
+run.
+
+=back
+
+C<new()> will not always return the I<same> object, but every object will share
+the same state.
+
+=cut
+
+.sub __init method
+       .param pmc args
+       .local pmc output
+       .local pmc testplan
+       .local pmc results
+
+       (output, testplan, results) = _assign_default_args( args )
+       self.'_assign_args'( output, testplan, results )
+.end
+
+.sub _assign_args method
+       .param pmc output
+       .param pmc testplan
+       .param pmc results
+
+       .local int offset
+       classoffset offset, self, 'Test::Builder'
+       setattribute self, offset, output
+       inc offset
+       setattribute self, offset, testplan
+       inc offset
+       setattribute self, offset, results
+.end
+
+=item C<create( args_hash )>
+
+Creates and returns a new Test::Builder object with different backend objects.
+This probably doesn't work correctly yet, but you will probably never use it.
+
+=cut
+
+.sub create method
+       .param pmc args
+
+       .local pmc output
+       .local pmc testplan
+       .local pmc results
+
+       .local int is_defined
+       output     = args['output']
+       is_defined = defined output
+       if is_defined goto OUTPUT_DEFINED
+
+       .local int output_class
+       find_type output_class, 'Test::Builder::Output'
+       output = new output_class
+
+  OUTPUT_DEFINED:
+       is_defined = exists args['testplan']
+       unless is_defined goto DEFAULT_TESTPLAN
+
+       testplan   = args['testplan']
+       goto TESTPLAN_DEFINED
+
+  DEFAULT_TESTPLAN:
+       testplan   = new .String
+       set testplan, ''
+
+  TESTPLAN_DEFINED:
+
+    results    = new .ResizablePMCArray
+
+       self.'_assign_args'( output, testplan, results )
+.end
+
+.sub _assign_default_args
+       .param pmc args
+
+       .local pmc output
+       .local pmc testplan
+       .local pmc results
+
+       output   = find_global 'Test::Builder::_singleton', 'output'
+       testplan = find_global 'Test::Builder::_singleton', 'testplan'
+       results  = find_global 'Test::Builder::_singleton', 'results'
+
+       .local int is_defined
+
+       # try for the global first
+       is_defined = isa output, 'Test::Builder::Output'
+       if is_defined goto OUTPUT_DEFINED
+
+       # now look in the args hash
+       is_defined = exists args['output']
+       unless is_defined goto CREATE_OUTPUT
+       output     = args['output']
+       goto OUTPUT_DEFINED
+
+       # now create a Test::Builder::Output object
+  CREATE_OUTPUT:
+       .local int output_type
+       find_type  output_type, 'Test::Builder::Output'
+
+       .local pmc args_hash
+       args_hash  = new Hash
+       output     = new output_type, args_hash
+
+  OUTPUT_DEFINED:
+       # look for the global testplan
+       is_defined = isa testplan, 'Test::Builder::TestPlan'
+       $S0 = typeof testplan
+       if is_defined goto TESTPLAN_DEFINED
+
+       # now try in the args hash
+       is_defined = exists args['testplan']
+       unless is_defined goto BACKUP_TESTPLAN
+       testplan = args['testplan']
+       goto TESTPLAN_DEFINED
+
+  BACKUP_TESTPLAN:
+       testplan   = new .String
+       set testplan, 'global_testplan'
+
+  TESTPLAN_DEFINED:
+       is_defined = isa results, 'ResizablePMCArray'
+       if is_defined goto RESULTS_DEFINED
+       results    = new .ResizablePMCArray
+
+  RESULTS_DEFINED:
+       store_global 'Test::Builder::_singleton',   'output',   output
+       store_global 'Test::Builder::_singleton', 'testplan', testplan
+       store_global 'Test::Builder::_singleton',  'results',  results
+
+       .return( output, testplan, results )
+.end
+
+.sub output method
+       .local pmc output
+       .local int offset
+
+       classoffset offset, self, 'Test::Builder'
+       getattribute output, self, offset
+
+       .return( output )
+.end
+
+.sub testplan method
+       .local pmc testplan
+       .local int offset
+
+       classoffset offset, self, 'Test::Builder'
+       inc offset
+       getattribute testplan, self, offset
+
+       .return( testplan )
+.end
+
+.sub results method
+       .local pmc output
+       .local int offset
+       .local pmc results
+
+       classoffset offset, self, 'Test::Builder'
+       add offset, 2
+       getattribute results, self, offset
+
+       .return( results )
+.end
+
+=item C<finish()>
+
+Finishes this test run.  You should call this when you have finished running
+all of the tests.  I know this is awful, but this has to be here until object
+finalization works reliably.
+
+This is probably not idempotent now, so try not to call it too many times,
+where "too many" means "more than one".
+
+=cut
+
+.sub finish method
+       .local pmc output
+       .local pmc testplan
+       .local pmc results
+
+       output   = self.'output'()
+       testplan = self.'testplan'()
+       results  = self.'results'()
+
+       .local int elements
+       elements = results
+
+       .local string footer
+       footer   = testplan.'footer'( elements )
+
+       .local int is_defined
+       is_defined = length footer
+       unless is_defined goto DONE_PRINTING
+       output.'write'( footer )
+
+  DONE_PRINTING:
+
+  # XXX - delete globals
+.end
+
+=item C<plan( number_or_no_plan )>
+
+Tells the object how many tests to run, either an integer greater than zero or
+the string C<no_plan>.  This will throw an exception if you have already
+declared a plan or if you pass an invalid argument.
+
+=cut
+
+.sub plan method
+       .param string explanation
+       .param int    tests
+
+       .local pmc testplan
+       testplan = self.'testplan'()
+
+       .local int vivify_global_testplan
+       .local int is_defined
+
+       .local int is_equal
+
+       eq_str testplan, 'global_testplan', SET_GLOBAL_TESTPLAN
+       goto CHECK_REPLAN
+
+  SET_GLOBAL_TESTPLAN:
+       vivify_global_testplan = 1
+       goto CHECK_TESTNUM
+
+  CHECK_REPLAN:
+       .local int valid_tp
+       valid_tp = does testplan, 'Test::Builder::TestPlan'
+
+       unless valid_tp goto CHECK_TESTNUM
+
+       .local pmc plan_exception
+       plan_exception = new .Exception
+       set   plan_exception['_message'], 'Plan already set!'
+       throw plan_exception
+
+  CHECK_TESTNUM:
+       unless tests goto CHECK_EXPLANATION
+
+       .local int plan_type
+       .local pmc args
+
+       args = new .Hash
+       set args['expect'], tests
+
+       find_type plan_type, 'Test::Builder::TestPlan'
+       testplan = new plan_type, args
+       goto FINISH_PLAN
+
+  CHECK_EXPLANATION:
+       eq_str explanation, 'no_plan', PLAN_NULL
+       goto PLAN_FAILURE
+
+  PLAN_NULL:
+       .local int null_type
+       find_type null_type, 'Test::Builder::NullPlan'
+       testplan = new null_type
+       goto FINISH_PLAN
+
+  PLAN_FAILURE:
+       .local pmc plan_exception
+       plan_exception = new .Exception
+       set   plan_exception['_message'], 'Unknown test plan!'
+       throw plan_exception
+
+  FINISH_PLAN:
+       unless vivify_global_testplan goto WRITE_HEADER 
+       store_global 'Test::Builder::_singleton', 'testplan', testplan
+
+  WRITE_HEADER:
+       .local pmc output
+       output = self.'output'()
+
+       .local string header
+       header = testplan.'header'()
+
+       .local int offset
+       classoffset offset, self, 'Test::Builder'
+       inc offset
+       setattribute self, offset, testplan
+       output.write( header )
+.end
+
+=item C<diag( diagnostic_message )>
+
+Records a diagnostic message for output.
+
+=cut
+
+.sub diag method
+       .param string diagnostic
+
+       if diagnostic goto DIAGNOSTIC_SET
+       .return()
+
+  DIAGNOSTIC_SET:
+       .local pmc output
+       output = self.'output'()
+       output.'diag'( diagnostic )
+.end
+
+=item C<ok( passed, description )>
+
+Records a test as pass or fail depending on the truth of the integer C<passed>,
+recording it with the optional test description in C<description>.
+
+=cut
+
+.sub ok method
+       .param int    passed
+       .param string description
+
+       .local pmc results
+       results = self.'results'()
+
+       .local int results_count
+       results_count = results
+       inc results_count
+
+       .local pmc test_args
+       test_args = new .Hash
+       set test_args['number'],      results_count
+       set test_args['passed'],      passed
+       set test_args['description'], description
+
+       self.'report_test'( test_args )
+
+       .return( passed )
+.end
+
+=item C<todo( passed, description, reason )>
+
+Records a test as pass or fail based on the truth of the integer C<passed>, but
+marks it as TODO so it always appears as a success.  This also records the
+optional C<description> of the test and the C<reason> you have marked it as
+TODO.
+
+=cut
+
+.sub todo method
+       .param int    passed
+       .param string description
+       .param string reason
+
+       .local pmc results
+       results = self.'results'()
+
+       .local int results_count
+       results_count = results
+       inc results_count
+
+       .local pmc test_args
+       test_args = new .Hash
+       set test_args['todo'],        1
+       set test_args['number'],      results_count
+       set test_args['passed'],      passed
+       set test_args['reason'],      reason
+       set test_args['description'], description
+
+       self.'report_test'( test_args )
+
+       .return( passed )
+.end
+
+=item C<skip( number reason )>
+
+Records C<number> of tests as skip tests, using the optional C<reason> to mark
+why you've skipped them.
+
+=cut
+
+.sub skip method
+       .param int    number
+       .param string reason
+
+       if number goto CHECK_REASON
+       number = 1
+
+  CHECK_REASON:
+    if reason goto SKIP_LOOP
+       set reason, 'skipped'
+
+  SKIP_LOOP:
+       .local pmc results
+       results = self.'results'()
+
+       .local int results_count
+       results_count = results
+
+       .local int loop_count
+       loop_count = 1
+
+  LOOP:
+       inc results_count
+
+       .local pmc test_args
+       test_args = new .Hash
+       set test_args['number'], results_count
+       set test_args['skip'],   1
+       set test_args['reason'], reason
+
+       self.'report_test'( test_args )
+       inc loop_count
+       if loop_count < number goto LOOP
+
+.end
+
+=item C<skip_all()>
+
+Skips all of the tests in a test file.  You cannot call this if you have a
+plan.  This calls C<exit>; there's little point in continuing.
+
+=cut
+
+.sub skip_all method
+       .local pmc testplan
+       testplan = self.'testplan'()
+
+       unless testplan goto SKIP_ALL
+
+       .local pmc plan_exception
+       plan_exception = new .Exception
+       set   plan_exception['_message'], 'Cannot skip_all() with a plan!'
+       throw plan_exception
+
+  SKIP_ALL:
+       .local pmc output
+       output = self.'output'()
+       output.'write'( "1..0" )
+       exit 0
+.end
+
+=item C<BAILOUT( reason )>
+
+Ends the test immediately, giving the string C<reason> as explanation.  This
+also calls C<exit>.
+
+=cut
+
+.sub BAILOUT method
+       .param string reason
+
+       .local pmc output
+       output  = self.'output'()
+
+       .local string bail_out
+       bail_out = 'Bail out!'
+
+       unless reason goto WRITE_REASON
+       concat bail_out, '  '
+       concat bail_out, reason
+
+  WRITE_REASON:
+       output.'write'( bail_out )
+
+       exit 0
+.end
+
+.sub report_test method
+       .param pmc test_args
+
+       .local pmc testplan
+       testplan = self.'testplan'()
+
+       .local int plan_ok
+       plan_ok = isa testplan, 'Test::Builder::TestPlan'
+       if plan_ok goto CREATE_TEST
+
+       .local pmc plan_exception
+       plan_exception = new .Exception
+       set   plan_exception['_message'], 'No plan set!'
+       throw plan_exception
+
+  CREATE_TEST:
+       .local pmc results
+       results = self.'results'()
+
+       .local pmc test
+
+       .local pmc number
+       number = new Integer
+       
+       .local int count
+       count  = results
+       number = count
+       inc number
+
+       set test_args['number'], number
+
+       push results, test
+
+       .local pmc tbt_create
+       find_global tbt_create, 'Test::Builder::Test', 'create'
+       test = tbt_create( test_args )
+
+       .local pmc output
+       output = self.'output'()
+
+       .local string report
+       report = test.'report'()
+
+       output.'write'( report )
+.end
+
+=back
+
+=head1 AUTHOR
+
+Written and maintained by chromatic, C<< chromatic at wgz dot org >>, based on
+the Perl 6 port he wrote, based on the original Perl 5 version he wrote with
+ideas from Michael G. Schwern.  Please send patches, feedback, and suggestions
+to the Perl 6 internals mailing list.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005, the Perl Foundation.
+
+=cut

Added: trunk/runtime/parrot/library/Test/Builder/Output.pir
==============================================================================
--- (empty file)
+++ trunk/runtime/parrot/library/Test/Builder/Output.pir        Sat Jul 30 
19:48:10 2005
@@ -0,0 +1,214 @@
+=head1 NAME
+
+Test::Builder::Output - manages output for Test::Builder
+
+=head1 SYNOPSIS
+
+See L<Test::Builder>.
+
+=head1 DESCRIPTION
+
+This class controls the output filehandles for Test::Builder.  You probably do
+not need to use it directly.
+
+=head1 METHODS
+
+This class defines the following methods:
+
+=over 4
+
+=cut
+
+.namespace [ 'Test::Builder::Output' ]
+
+.sub _initialize @LOAD
+       .local pmc   tbo_class
+       newclass     tbo_class, 'Test::Builder::Output'
+       addattribute tbo_class, 'output'
+       addattribute tbo_class, 'diag_output'
+.end
+
+=item C<new( args_hash )>
+
+Initializes a new Test::Builder::Output object (when you create it with
+C<new>), passing optional arguments in C<args_hash>.  They are:
+
+=over 4
+
+=item C<output>
+
+An IO PMC for the filehandle to which normal output should go.  This uses
+STDOUT by default.
+
+=item C<diag_output>
+
+An IO PMC for the filehandle to which diagnostic output should go.  This uses
+STDERR by default.
+
+=back
+
+=cut
+
+.sub __init method
+       .param pmc args
+
+       .local pmc output
+       .local pmc diag_output
+
+       output = args['output']
+       if output goto CHECK_ERROR_OUTPUT
+       getstdout output
+
+  CHECK_ERROR_OUTPUT:
+       diag_output = args['diag_output']
+       if diag_output goto SET_OUTPUT
+       getstderr diag_output
+
+  SET_OUTPUT:
+       .local int offset
+       classoffset offset, self, 'Test::Builder::Output'
+       setattribute self, offset, output
+       inc offset
+       setattribute self, offset, diag_output
+.end
+
+.sub output method
+       .local pmc output
+       .local int offset
+
+       classoffset offset, self, 'Test::Builder::Output'
+       getattribute output, self, offset
+
+       .return( output )
+.end
+
+.sub diag_output method
+       .local pmc diag_output
+       .local int offset
+
+       classoffset offset, self, 'Test::Builder::Output'
+       getattribute diag_output, self, offset
+
+       .return( diag_output )
+.end
+
+=item C<write( message )>
+
+Writes the string C<message> to the output filehandle, TAP-escaping any
+unescaped newlines.
+
+=cut
+
+.sub write method
+       .param string message
+
+       .local int message_length
+       message_length = length message
+       if message_length > 0 goto HAVE_MESSAGE
+       .return()
+
+  HAVE_MESSAGE:
+       message = self.'escape_newlines'( message )
+
+       .local pmc output
+       output = self.'output'()
+       output.'puts'( message )
+.end
+
+.sub escape_newlines method
+       .param string message
+       .local pmc lines
+       lines = new ResizableStringArray
+
+       .local int newline_index
+       .local string line
+
+  SPLIT_LOOP:
+       newline_index = index message, "\n"
+       if newline_index == -1 goto END_LOOP
+       line = substr message, 0, newline_index, ''
+       push lines, line
+       if message goto SPLIT_LOOP
+
+  END_LOOP:
+       push lines, message
+       .local int num_lines
+       num_lines = lines
+
+       # loop from 0 to index of final element
+       dec num_lines
+
+       .local int i
+       i = 0
+
+       .local string first_char
+       .local string line
+
+  LOOP:
+    if i == 0 goto LINE_OK
+       line       = lines[i]
+       first_char = substr line, 0, 1
+       eq_str first_char, '#', LINE_OK
+
+       .local string new_line
+       new_line = '# '
+       concat new_line, line
+       lines[i] = new_line
+
+  LINE_OK:
+
+       inc i
+       if i < num_lines goto LOOP
+       
+       message = join '', lines
+       concat message, "\n"
+
+       .return( message )
+.end
+
+=item C<diag( message )>
+
+Writes the string C<message> to the diagnostic filehandle, TAP-escaping any
+unescaped newlines.
+
+=cut
+
+.sub diag method
+       .param string message
+
+       .local int message_length
+       message_length = length message
+       if message_length > 0 goto HAVE_MESSAGE
+       .return()
+
+  HAVE_MESSAGE:
+       message = self.'escape_newlines'( message )
+
+       .local string first_char
+       first_char = substr message, 0, 1
+       eq_str first_char, '#', WRITE_MESSAGE
+
+       first_char = '# '
+       concat first_char, message
+       message = first_char
+
+  WRITE_MESSAGE:
+       .local pmc diag_output
+       diag_output = self.'diag_output'()
+       diag_output.'puts'( message )
+.end
+
+=back
+
+=head1 AUTHOR
+
+Written and maintained by chromatic, C<< chromatic at wgz dot org >>, based on
+the Perl 6 port he wrote, based on the original Perl 5 version he wrote with
+ideas from Michael G. Schwern.  Please send patches, feedback, and suggestions
+to the Perl 6 internals mailing list.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005, the Perl Foundation.
+
+=cut

Added: trunk/runtime/parrot/library/Test/Builder/Test.pir
==============================================================================
--- (empty file)
+++ trunk/runtime/parrot/library/Test/Builder/Test.pir  Sat Jul 30 19:48:10 2005
@@ -0,0 +1,406 @@
+=head1 NAME
+
+Test::Builder::Test - base class for all Test::Builder test objects
+
+=head1 SYNOPSIS
+
+See L<Test::Builder>.  You probably don't need to use this directly.
+
+=head1 METHODS
+
+This class provides the following methods:
+
+=over 4
+
+=cut
+
+.namespace [ 'Test::Builder::Test' ]
+
+.sub _initialize @LOAD
+       .local pmc tbtb_class
+
+       newclass     tbtb_class, 'Test::Builder::Test::Base'
+       addattribute tbtb_class, 'passed'
+       addattribute tbtb_class, 'number'
+       addattribute tbtb_class, 'diagnostic'
+       addattribute tbtb_class, 'description'
+
+       .local pmc tbtp_class
+       subclass tbtp_class, tbtb_class, 'Test::Builder::Test::Pass'
+
+       .local pmc tbtf_class
+       subclass tbtf_class, tbtb_class, 'Test::Builder::Test::Fail'
+
+       .local pmc tbtwr_class
+       subclass tbtwr_class, tbtb_class, 'Test::Builder::Test::WithReason'
+       addattribute tbtwr_class, 'reason'
+
+       .local pmc tbts_class
+       subclass tbts_class, tbtwr_class, 'Test::Builder::Test::Skip'
+
+       .local pmc tbtt_class
+       subclass tbtt_class, tbtwr_class, 'Test::Builder::Test::TODO'
+.end
+
+=item C<create( args_hash )>
+
+Creates and returns a new test object, based on the arguments in the
+C<args_hash> hash.  Yes, this is a facade factory.  The arguments are:
+
+=over 4
+
+=item C<number>
+
+The number of the test.  This is important.
+
+=item C<passed>
+
+An integer representing whether the test passed or failed.
+
+=item C<skip>
+
+An integer representing whether the test is a skip test.
+
+=item C<reason>
+
+The string reason why this is a skip or TODO test.
+
+=item C<todo>
+
+An integer representing whether the test is a TODO test.
+
+=item C<description>
+
+The string description of this test.
+
+=back
+
+The returned object is a subclass of Test::Builder::Test.
+
+=cut
+
+.sub create
+       .param pmc args
+
+       .local int test_class
+       .local int type_flag
+
+  CHECK_TODO:
+       type_flag = args['todo']
+       unless type_flag goto CHECK_SKIP
+
+       find_type test_class, 'Test::Builder::Test::TODO'
+       goto CREATE_TEST
+
+  CHECK_SKIP:
+       type_flag = args['skip']
+       unless type_flag goto CHECK_PASS
+
+       find_type test_class, 'Test::Builder::Test::Skip'
+       goto CREATE_TEST
+
+  CHECK_PASS:
+       type_flag = args['passed']
+       unless type_flag goto CHECK_FAIL
+
+       find_type test_class, 'Test::Builder::Test::Pass'
+       goto CREATE_TEST
+
+  CHECK_FAIL:
+       find_type test_class, 'Test::Builder::Test::Fail'
+       goto CREATE_TEST
+
+  CREATE_TEST:
+       .local pmc test
+       test = new test_class, args
+       .return( test )
+.end
+
+=item C<status()>
+
+Returns a C<Hash> containing information about this test -- mostly the
+information you pass to C<create()>.
+
+=item C<report()>
+
+Returns the TAP-compatible string representation of this test.
+
+=cut
+
+.namespace [ 'Test::Builder::Test::Base' ]
+
+.sub __init method
+       .param pmc args
+
+       .local int offset
+       .local pmc passed
+       .local pmc number
+       .local pmc diagnostic
+       .local pmc description
+
+       classoffset offset, self, 'Test::Builder::Test::Base'
+
+       passed = args['passed']
+       setattribute self, offset, passed
+       inc offset
+
+       number = args['number']
+       if number goto SET_NUMBER
+       number = new .Integer
+       number = 0
+
+  SET_NUMBER:
+       setattribute self, offset, number
+       inc offset
+
+       diagnostic = args['diagnostic']
+       if diagnostic goto SET_DIAGNOSTIC
+       diagnostic = new .String
+       set diagnostic, '???'
+
+  SET_DIAGNOSTIC:
+       setattribute self, offset, diagnostic
+       inc offset
+
+       description = args['description']
+       if description goto SET_DESCRIPTION
+       description = new .String
+       set description, ''
+
+  SET_DESCRIPTION:
+       setattribute self, offset, description
+.end
+
+.sub passed method
+       .local pmc passed
+       .local int offset
+
+       classoffset offset, self, 'Test::Builder::Test::Base'
+       getattribute passed, self, offset
+
+       .return( passed )
+.end
+
+.sub number method
+       .local pmc number
+       .local int offset
+
+       classoffset offset, self, 'Test::Builder::Test::Base'
+       inc offset
+
+       getattribute number, self, offset
+       .return( number )
+.end
+
+.sub diagnostic method
+       .local pmc diagnostic
+       .local int offset
+
+       classoffset offset, self, 'Test::Builder::Test::Base'
+       add offset, 2
+
+       getattribute diagnostic, self, offset
+       .return( diagnostic )
+.end
+
+.sub description method
+       .local pmc description
+       .local int offset
+
+       classoffset offset, self, 'Test::Builder::Test::Base'
+       add offset, 3
+
+       getattribute description, self, offset
+       .return( description )
+.end
+
+.sub status method
+       .local pmc passed
+       .local pmc description
+       .local pmc status
+       
+       passed      = self.'passed'()
+       description = self.'description'()
+
+       status = new .Hash
+       set status['passed'],      passed
+       set status['description'], description
+.end
+
+.sub report method
+       .local pmc    passed
+       .local pmc    number
+       .local pmc    description
+       .local string report
+       .local string number_string
+       .local string desc_string
+       
+       passed        = self.'passed'()
+       number        = self.'number'()
+       description   = self.'description'()
+       report        = ''
+       number_string = number
+       desc_string   = description
+
+       if passed goto PASSED
+       set report, 'not '
+
+  PASSED:
+       concat report, 'ok '
+       concat report, number_string
+
+       unless description goto REPORT
+
+       concat report, ' - '
+       concat report, desc_string
+
+  REPORT:
+       .return( report )
+.end
+
+# no code here
+.namespace [ 'Test::Builder::Test::Pass' ]
+
+# no code here either
+.namespace [ 'Test::Builder::Test::Fail' ]
+
+.namespace [ 'Test::Builder::Test::WithReason' ]
+
+.sub __init method
+       .param pmc args
+
+       .local int offset
+       .local pmc reason
+       reason = new .String
+       set reason, ''
+
+       .local int is_defined
+       is_defined = exists args['reason']
+       unless is_defined goto SET_ATTRIBUTE
+       reason = args['reason']
+
+  SET_ATTRIBUTE:
+       classoffset offset, self, 'Test::Builder::Test::WithReason'
+       setattribute self, offset, reason
+.end
+
+.sub reason method
+       .local pmc reason
+       .local int offset
+
+       classoffset offset, self, 'Test::Builder::Test::WithReason'
+       getattribute reason, self, offset
+
+       .return( reason )
+.end
+
+.sub status method
+       .local pmc reason
+       .local pmc status
+       .local pmc parent_status
+
+       parent_status = find_global 'Test::Builder::Test::WithReason', 'status'
+       status        = parent_status()
+       reason        = self.'reason'()
+
+       set status['reason'], reason
+
+       .return( status )
+.end
+
+.namespace [ 'Test::Builder::Test::Skip' ]
+
+.sub report method
+       .local pmc    reason
+       .local pmc    number
+       .local string report
+       .local string number_string
+       .local string reason_string
+
+       number        = self.'number'()
+       reason        = self.'reason'()
+       report        = 'not ok '
+       number_string = number
+       reason_string = reason
+
+       concat report, number_string
+       concat report, ' #skip '
+       concat report, reason_string
+
+       .return( report )
+.end
+
+.sub status method
+       .local pmc status
+       .local pmc parent_status
+
+       parent_status = find_global 'Test::Builder::Test::WithReason', 'status'
+       status        = parent_status()
+
+       set status['skip'], 1
+       .return( status )
+.end
+
+.namespace [ 'Test::Builder::Test::TODO' ]
+
+.sub report method
+       .local pmc    passed
+       .local pmc    description
+       .local pmc    number
+       .local string report
+       .local string number_string
+       .local string desc_string
+
+       passed        = self.'passed'()
+       number        = self.'number'()
+       description   = self.'description'()
+       report        = ''
+       number_string = number
+       desc_string   = description
+
+       if passed goto PASSED
+       report      = 'not '
+
+  PASSED:
+       concat report, 'ok '
+       concat report, number_string
+       concat report, ' # TODO'
+
+       unless description goto REPORT
+       concat report, ' '
+       concat report, desc_string
+
+  REPORT:
+       .return( report )
+.end
+
+.sub status method
+       .local pmc passed
+       .local pmc status
+       .local pmc parent_status
+
+       parent_status = find_global 'Test::Builder::Test::WithReason', 'status'
+       status        = parent_status()
+       passed        = self.'passed'()
+
+       set status['TODO'],          1
+       set status['passed'],        1
+       set status['really_passed'], 1
+
+       .return( status )
+.end
+
+=back
+
+=head1 AUTHOR
+
+Written and maintained by chromatic, C<< chromatic at wgz dot org >>, based on
+the Perl 6 port he wrote, based on the original Perl 5 version he wrote with
+ideas from Michael G. Schwern.  Please send patches, feedback, and suggestions
+to the Perl 6 internals mailing list.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005, the Perl Foundation.
+
+=cut

Added: trunk/runtime/parrot/library/Test/Builder/TestPlan.pir
==============================================================================
--- (empty file)
+++ trunk/runtime/parrot/library/Test/Builder/TestPlan.pir      Sat Jul 30 
19:48:10 2005
@@ -0,0 +1,175 @@
+=head1 NAME
+
+Test::Builder::TestPlan - class representing the current Test::Builder test 
plan
+
+=head1 SYNOPSIS
+
+See L<Test::Builder>.
+
+=head1 DESCRIPTION
+
+This class contains the details of the test plan for a test run controlled by
+Test::Builder.  You probably will never use this directly.
+
+There are two actually classes here.  Test::Builder::TestPlan represents a plan
+with a number -- a plan where you know how many tests you plan to run.
+Test::Builder::NullPlan represents a test where you do not know this.
+
+=head1 METHODS
+
+Both classes support the following methods.
+
+=over 4
+
+=cut
+
+.namespace [ 'Test::Builder::TestPlan' ]
+
+.sub _initialize @LOAD
+       .local pmc tbtp_class
+       newclass     tbtp_class, 'Test::Builder::TestPlan'
+       addattribute tbtp_class, 'expect'
+
+       # XXX - can't seem to do this within its own class
+       .local pmc tbnp_class
+       subclass tbnp_class, tbtp_class, 'Test::Builder::NullPlan'
+.end
+
+=item C<new( args_hash )>
+
+Initializes a new object after you create it with C<new>.  If you're creating a
+Test::Builder::TestPlan object, pass an C<args_hash> hash containing an
+C<expect> key with the number of tests you plan to run.  If you're creating a
+Test::Builder::NullPlan object, do not pass the hash.
+
+=cut
+
+.sub __init method
+       .param pmc args
+
+       .local int valid_args
+       valid_args = isa args, 'Hash'
+       if valid_args goto CHECK_ARGS
+
+       # hope this is for Test::Builder::NullPlan
+       .return()
+
+  CHECK_ARGS:
+       .local int expect
+       .local int expect_exists
+       expect_exists = exists args['expect']
+       unless expect_exists goto NO_EXPECTATION
+       expect = args['expect']
+       goto SET_ATTRIBUTES
+
+  NO_EXPECTATION:
+       .local pmc plan_exception
+       plan_exception = new .Exception
+       set   plan_exception['_message'], 'Invalid or missing plan!'
+       throw plan_exception
+
+  SET_ATTRIBUTES:
+       .local int offset
+       classoffset offset, self, 'Test::Builder::TestPlan'
+
+       .local pmc intvalue
+       intvalue = new .Integer
+       intvalue = expect
+       setattribute self, offset, intvalue
+.end
+
+=item C<header()>
+
+Returns a string containing the appropriate TAP-compatible header for this test
+plan.
+
+=cut
+
+.sub header method
+       .local string expect
+       .local int    offset
+       .local string header
+
+       classoffset offset, self, 'Test::Builder::TestPlan'
+
+       .local pmc expect_int
+       getattribute expect_int, self, offset
+       expect = expect_int
+
+       header = '1..'
+       concat header, expect
+
+       .return( header )
+.end
+
+=item C<footer()>
+
+Returns a string containing the appropriate TAP-compatible footer for this test
+plan.
+
+=cut
+
+.sub footer method
+       .param int    ran
+
+       .local int    expect
+       .local int    offset
+       .local string footer
+       .local string expect_string
+       .local string ran_string
+
+       classoffset offset, self, 'Test::Builder::TestPlan'
+
+       .local pmc expect_int
+       getattribute expect_int, self, offset
+
+       expect        = expect_int
+       expect_string = expect_int
+       ran_string    = ran
+       footer        = ''
+
+       if ran == expect goto PLAN_MATCHED
+       concat footer, 'Expected '
+       concat footer, expect_string
+       concat footer, ' but ran '
+       concat footer, ran_string
+
+  PLAN_MATCHED:
+       .return( footer )
+.end
+
+.namespace [ 'Test::Builder::NullPlan' ]
+
+.sub header method
+       .local string header
+       header = ''
+       .return( header )
+.end
+
+.sub footer method
+       .param int tests_run
+
+       .local string tests_run_string
+       .local string footer
+
+       footer           = "1.."
+       tests_run_string = tests_run
+
+       concat footer, tests_run_string
+       .return( footer )
+.end
+
+=back
+
+=head1 AUTHOR
+
+Written and maintained by chromatic, C<< chromatic at wgz dot org >>, based on
+the Perl 6 port he wrote, based on the original Perl 5 version he wrote with
+ideas from Michael G. Schwern.  Please send patches, feedback, and suggestions
+to the Perl 6 internals mailing list.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2005, the Perl Foundation.
+
+=cut

Reply via email to