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