1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
#!perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use strict;
use Test::More tests => 7;
my $Test = Test::More->builder;
# now make a filehandle where we can send data
my $output;
tie *FAKEOUT, 'FakeOut', \$output;
# force diagnostic output to a filehandle, glad I added this to
# Test::Builder :)
my @lines;
my $ret;
{
local $TODO = 1;
$Test->todo_output(\*FAKEOUT);
diag("a single line");
push @lines, $output;
$output = '';
$ret = diag("multiple\n", "lines");
push @lines, split(/\n/, $output);
}
is( @lines, 3, 'diag() should send messages to its filehandle' );
like( $lines[0], '/^#\s+/', ' should add comment mark to all lines' );
is( $lines[0], "# a single line\n", ' should send exact message' );
is( $output, "# multiple\n# lines\n", ' should append multi messages');
ok( !$ret, 'diag returns false' );
{
$Test->failure_output(\*FAKEOUT);
$output = '';
$ret = diag("# foo");
}
$Test->failure_output(\*STDERR);
is( $output, "# # foo\n", "diag() adds a # even if there's one already" );
ok( !$ret, 'diag returns false' );
package FakeOut;
sub TIEHANDLE {
bless( $_[1], $_[0] );
}
sub PRINT {
my $self = shift;
$$self .= join('', @_);
}
|
