Commit | Line | Data |
33459055 |
1 | #!perl -w |
3e887aae |
2 | |
3 | use strict; |
33459055 |
4 | |
5 | BEGIN { |
a9153838 |
6 | if( $ENV{PERL_CORE} ) { |
7 | chdir 't'; |
89c1e84a |
8 | @INC = ('../lib', 'lib'); |
9 | } |
10 | else { |
11 | unshift @INC, 't/lib'; |
a9153838 |
12 | } |
33459055 |
13 | } |
30e302f8 |
14 | chdir 't'; |
15 | |
3e887aae |
16 | use Test::Builder; |
33459055 |
17 | |
3e887aae |
18 | # The real Test::Builder |
19 | my $Test = Test::Builder->new; |
20 | $Test->plan( tests => 6 ); |
89c1e84a |
21 | |
33459055 |
22 | |
3e887aae |
23 | # The one we're going to test. |
24 | my $tb = Test::Builder->create(); |
33459055 |
25 | |
30e302f8 |
26 | my $tmpfile = 'foo.tmp'; |
6b38a9b9 |
27 | END { 1 while unlink($tmpfile) } |
33459055 |
28 | |
3e887aae |
29 | # Test output to a file |
30 | { |
31 | my $out = $tb->output($tmpfile); |
32 | $Test->ok( defined $out ); |
33 | |
34 | print $out "hi!\n"; |
35 | close *$out; |
36 | |
37 | undef $out; |
38 | open(IN, $tmpfile) or die $!; |
39 | chomp(my $line = <IN>); |
40 | close IN; |
41 | |
42 | $Test->is_eq($line, 'hi!'); |
43 | } |
44 | |
45 | |
46 | # Test output to a filehandle |
47 | { |
48 | open(FOO, ">>$tmpfile") or die $!; |
49 | my $out = $tb->output(\*FOO); |
50 | my $old = select *$out; |
51 | print "Hello!\n"; |
52 | close *$out; |
53 | undef $out; |
54 | select $old; |
55 | open(IN, $tmpfile) or die $!; |
56 | my @lines = <IN>; |
57 | close IN; |
58 | |
59 | $Test->like($lines[1], qr/Hello!/); |
60 | } |
33459055 |
61 | |
33459055 |
62 | |
3e887aae |
63 | # Test output to a scalar ref |
64 | { |
65 | my $scalar = ''; |
66 | my $out = $tb->output(\$scalar); |
67 | |
68 | print $out "Hey hey hey!\n"; |
69 | $Test->is_eq($scalar, "Hey hey hey!\n"); |
70 | } |
4bd4e70a |
71 | |
33459055 |
72 | |
3e887aae |
73 | # Test we can output to the same scalar ref |
74 | { |
75 | my $scalar = ''; |
76 | my $out = $tb->output(\$scalar); |
77 | my $err = $tb->failure_output(\$scalar); |
33459055 |
78 | |
3e887aae |
79 | print $out "To output "; |
80 | print $err "and beyond!"; |
33459055 |
81 | |
3e887aae |
82 | $Test->is_eq($scalar, "To output and beyond!", "One scalar, two filehandles"); |
83 | } |
89c1e84a |
84 | |
85 | |
86 | # Ensure stray newline in name escaping works. |
3e887aae |
87 | { |
88 | my $fakeout = ''; |
89 | my $out = $tb->output(\$fakeout); |
90 | $tb->exported_to(__PACKAGE__); |
91 | $tb->no_ending(1); |
92 | $tb->plan(tests => 5); |
93 | |
94 | $tb->ok(1, "ok"); |
95 | $tb->ok(1, "ok\n"); |
96 | $tb->ok(1, "ok, like\nok"); |
97 | $tb->skip("wibble\nmoof"); |
98 | $tb->todo_skip("todo\nskip\n"); |
99 | |
100 | $Test->is_eq( $fakeout, <<OUTPUT ) || print STDERR $fakeout; |
89c1e84a |
101 | 1..5 |
102 | ok 1 - ok |
103 | ok 2 - ok |
104 | # |
105 | ok 3 - ok, like |
106 | # ok |
107 | ok 4 # skip wibble |
108 | # moof |
109 | not ok 5 # TODO & SKIP todo |
110 | # skip |
111 | # |
112 | OUTPUT |
3e887aae |
113 | } |