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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
# !perl
#$Id: 08_iohandle_say.t 1213 2008-02-09 23:40:34Z jimk $
# 08_iohandle_say.t - test say() vs. IO::Handle::say()
use strict;
use warnings;
use Test::More tests => 14;
use lib ( qq{./t/lib} );
BEGIN {
use_ok('IO::Handle');
use_ok('Carp');
use_ok('Perl6::Say::Auxiliary', qw| _validate capture_say |);
};
my $iohandleversion;
SKIP: {
my $skipped_tests = (14 - 3);
eval { $iohandleversion = $IO::Handle::VERSION; };
skip "tests require $IO::Handle::VERSION",
$skipped_tests
if $@;
SKIP: {
skip "tests require IO::Handle module version 1.27 or greater",
$skipped_tests
unless $iohandleversion >= 1.27;
# real tests go here
can_ok( q{IO::Handle}, qw( say ) );
undef &IO::Handle::say;
eval { say STDOUT "Gotcha!"; };
like($@, qr/^Undefined subroutine &IO::Handle::say called/,
"IO::Handle::say() is now undefined");
require_ok('Perl6::Say');
SKIP: {
eval qq{ require IO::Capture::Stdout; };;
skip "tests require IO::Capture::Stdout",
8 if $@;
my ($str, $say_sub, $msg);
$say_sub = sub { say STDOUT $str; };
$msg = q{correctly printed to STDOUT as named print filehandle};
$str = qq{Hello World};
capture_say( {
data => $str,
pred => 1,
eval => $say_sub,
msg => $msg,
} );
$str = qq{Hello World\n};
capture_say( {
data => $str,
pred => 2,
eval => $say_sub,
msg => $msg,
} );
$str = qq{Hello World\nAgain!\n};
capture_say( {
data => $str,
pred => 3,
eval => $say_sub,
msg => $msg,
} );
$str = qq{};
capture_say( {
data => $str,
pred => 1,
eval => $say_sub,
msg => $msg,
} );
$say_sub = sub { IO::Handle::say STDOUT $str; };
$msg = q{Perl6::Say::say() now IO::Handle::say()};
$str = qq{Hello World};
capture_say( {
data => $str,
pred => 1,
eval => $say_sub,
msg => $msg,
} );
$str = qq{Hello World\n};
capture_say( {
data => $str,
pred => 2,
eval => $say_sub,
msg => $msg,
} );
$str = qq{Hello World\nAgain!\n};
capture_say( {
data => $str,
pred => 3,
eval => $say_sub,
msg => $msg,
} );
$str = qq{};
capture_say( {
data => $str,
pred => 1,
eval => $say_sub,
msg => $msg,
} );
}
}
}
|
