use v6-alpha; module Test::Builder::Tester-0.2.1; use Test::Builder; use Test::Builder::Output; class Test::Builder::Tester::Output { has @!output; has @!diagnostics; method write ( Str $message is copy ) { push @!output, $message; } method diag ( Str $message is copy ) { push @!diagnostics, $message; } method output returns Str { # XXX - hack or pugsbug? return '' unless +@!output; my $output = @!output.join( "\n" ); @!output = (); return $output; } method diagnostics returns Str { # XXX - hack or pugsbug? return '' unless +@!diagnostics; my $diagnostics = @!diagnostics.join( "\n" ); @!diagnostics = (); return $diagnostics; } } my $Test = Test::Builder.create( output => Test::Builder::Output.new() ); my @expect_out; my @expect_diag; # populate the Test::Builder singleton with a controlled object my $tb_output = Test::Builder::Tester::Output.new(); my $tb_test = Test::Builder.new( output => $tb_output ); $tb_test.plan( 'no_plan' ); # remove header from output object; it gets in the way of the first test $tb_output.output(); sub plan ( Int $tests ) is export { $Test.plan( tests => $tests ); } sub line_num is export { } sub test_pass ( Str $diagnostic? ) is export { report_test( 'ok', $diagnostic ); } sub test_fail ( Str $diagnostic? ) is export { report_test( 'not ok', $diagnostic ); } sub report_test ( Str $type, Str $diagnostic? ) { my $number = $tb_test.get_test_number(); my $line = "$type $number"; $line ~= " - $diagnostic" if defined $diagnostic; test_out( $line ); } sub test_out ( Str $line ) is export { push @expect_out, $line; } sub test_err ( Str $line ) is export { push @expect_diag, $line; } sub test_diag ( Str $line ) is export { push @expect_diag, $line; } sub test_test ( Str $description = '' ) returns Bit is export { my $expect_out = @expect_out.join( "\n" ) || ''; my $expect_diag = @expect_diag.join( "\n" ) || ''; @expect_out = (); @expect_diag = (); my $received_out = $tb_output.output(); my $received_diag = $tb_output.diagnostics(); my $out_matches = $expect_out eq $received_out; my $diag_matches = $expect_diag eq $received_diag; return 1 if $Test.ok( ($out_matches && $diag_matches), $description ); $Test.diag( "output mismatch\nexpected: $expect_out\nreceived: $received_out\n" ) unless $out_matches; $Test.diag( "diagnostics mismatch\n" ~ "expected: '$expect_diag'\nreceived: '$received_diag'\n" ) unless $diag_matches; return 0; } =pod =head1 NAME Test::Builder::Tester =head1 SYNOPSIS use Test::Builder; use Test::Builder::Tester; plan 2; my $Test = Test::Builder.new(); test_out( 'ok 1 - Hello' ); $Test.ok( 1, 'Hello' ); test_test( 'passing_test ); test_out( 'not ok 2 - Goodbye' ); test_diag( "The test failed!" ); $Test.ok( 0, 'Goodbye' ) || $Test.diag( 'The test failed!' ); test_test( 'failing test with diagnostics' ); =head1 DESCRIPTION This test module allows you to test test modules that use Test::Builder. It does this by you setting the expected output and diagnostic output of tests, running those tests, and then telling this module to compare the received output to the expected output. =head1 EXPORTED FUNCTIONS =over 4 =item B Plans the number of tests to run. Someday there will be a C version of this too. For now, this is what you have. =item B Marks that the next test should pass. C<$description> is the optional description of the test. This is the easiest way to match a passing test. =item B Marks that the next test should fail. C<$description> is the optional description of the test. This is the easiest way to match a failing test. =item B Adds a line to the list of lines of expected output for the test you're going to run. =item B Adds a line to the list of lines of expected diagnostics for the test you're going to run. =item B Compares the receivied and expected lines from the previously run tests, passing if both the diagnostics and output match exactly. If you pass C<$description>, this will use it as the test description. =back =head1 AUTHOR based on L by Mark Fowler ported to Perl 6 by chromatic C<< chromatic at wgz dot org >> =cut