1#!perl -w 2 3BEGIN { 4 if( $ENV{PERL_CORE} ) { 5 chdir 't'; 6 @INC = ('../lib', 'lib'); 7 } 8 else { 9 unshift @INC, 't/lib'; 10 } 11} 12 13# Can't use Test.pm, that's a 5.005 thing. 14print "1..4\n"; 15 16my $test_num = 1; 17# Utility testing functions. 18sub ok ($;$) { 19 my($test, $name) = @_; 20 my $ok = ''; 21 $ok .= "not " unless $test; 22 $ok .= "ok $test_num"; 23 $ok .= " - $name" if defined $name; 24 $ok .= "\n"; 25 print $ok; 26 $test_num++; 27 28 return $test; 29} 30 31use TieOut; 32use Test::Builder; 33my $Test = Test::Builder->new(); 34 35my $result; 36my $out = $Test->output('foo'); 37 38ok( defined $out ); 39 40print $out "hi!\n"; 41close *$out; 42 43undef $out; 44open(IN, 'foo') or die $!; 45chomp(my $line = <IN>); 46close IN; 47 48ok($line eq 'hi!'); 49 50open(FOO, ">>foo") or die $!; 51$out = $Test->output(\*FOO); 52$old = select *$out; 53print "Hello!\n"; 54close *$out; 55undef $out; 56select $old; 57open(IN, 'foo') or die $!; 58my @lines = <IN>; 59close IN; 60 61ok($lines[1] =~ /Hello!/); 62 63unlink('foo'); 64 65 66# Ensure stray newline in name escaping works. 67$out = tie *FAKEOUT, 'TieOut'; 68$Test->output(\*FAKEOUT); 69$Test->exported_to(__PACKAGE__); 70$Test->no_ending(1); 71$Test->plan(tests => 5); 72 73$Test->ok(1, "ok"); 74$Test->ok(1, "ok\n"); 75$Test->ok(1, "ok, like\nok"); 76$Test->skip("wibble\nmoof"); 77$Test->todo_skip("todo\nskip\n"); 78 79my $output = $out->read; 80ok( $output eq <<OUTPUT ) || print STDERR $output; 811..5 82ok 1 - ok 83ok 2 - ok 84# 85ok 3 - ok, like 86# ok 87ok 4 # skip wibble 88# moof 89not ok 5 # TODO & SKIP todo 90# skip 91# 92OUTPUT 93