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