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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
#!perl -T
# -*- mode: cperl ; compile-command: "cd .. ; ./Build ; prove -vb t/12-*.t" -*-
BEGIN { $_ = defined && /(.*)/ && $1 for @ENV{qw/ TMPDIR TEMP TMP /} } # taint vs tempfile
use Test::More tests => 10;
use strict;
use warnings;
# A whole lot simpler testing -- we're now just checking that all the
# error situations are caught and behave sensibly. Okay, it's not
# that simple -- just simpler than the implementation ...
my $errnum = 11; # "Resource temporarily unavailable" locally -- sounds good :-P
my $errstring = do { local $! = $errnum; "$!" };
{
my $fileno = fileno STDIN;
die "STDIN not on fd 0"
unless defined $fileno and $fileno == 0;
};
our ($when_to_fail, $when_to_persist);
my ($glob, $mode, @what);
BEGIN {
# make the open calls in SystemSafe.pm fail or just fdopen STDIN in
# different situations:
*Test::Trap::Builder::SystemSafe::open = # silence warnings
*Test::Trap::Builder::SystemSafe::open = sub (*;$@) {
($glob, $mode, @what) = @_;
unless (@what) {
($mode, @what) = $mode =~ /^([>&=]*)\s*(.*)/s;
}
if ($when_to_persist and $when_to_persist->()) {
eval { open $_[0], '<&=STDIN' } or CORE::exit diag "Cannot fdopen STDIN; STDIN fd: ". fileno STDIN;
for (fileno $_[0]) {
defined or CORE::exit diag "fdopen STDIN gives undefined fd";
$_ == 0 or CORE::exit diag "fdopen STDIN gives fd $_";
}
return 1;
}
if ($when_to_fail and $when_to_fail->()) {
$! = $errnum;
return;
}
my $return;
if (@_ > 2) {
$return = open $_[0], $_[1], @_[2..$#_];
}
elsif (defined $_[0]){
$return = open $_[0], $_[1];
}
else {
$return = open my $fh, $_[1];
$_[0] = $fh;
}
return $return;
};
}
use Test::Trap::Builder::SystemSafe;
use Test::Trap qw( trap $T :flow:stderr(systemsafe):stdout(systemsafe):warn );
use Test::Trap qw( protect $P );
SKIP: {
skip 'These tests are broken on old perls', 3 if $] < 5.008;
protect { # return fd 0 again and again on appending
local $when_to_persist = sub { $mode eq '>>' };
eval { trap { 1 } };
like( $@, qr/^\QGetting several files opened on fileno 0 at ${\__FILE__}/, 'Persisting on STDIN' );
};
protect { # return fd 0 once(!) on appending
my $count = 1;
local $when_to_persist = sub { $mode eq '>>' and !--$count };
eval { trap { 1 } };
like( $@, qr/^Getting fileno \d+; \Qexpecting 0 at ${\__FILE__}/, "Mixed-up filenos" );
};
protect { # return fd 0 once(!) on appending -- then fail!
my $count = 1;
local $when_to_persist = sub { $mode eq '>>' and !--$count };
local $when_to_fail = sub { $mode eq '>>' and $count == -1 };
eval { trap { 1 } };
like( $@, qr/^Cannot open \S+ \Qfor stdout: '$errstring' at ${\__FILE__}/, 'Delayed append to tempfile' );
};
}
protect { # fail on the first dup() -- stdout, coming in
my $count = 1;
local $when_to_fail = sub { $mode eq '>&' and !--$count };
eval { trap { 1 } };
like( $@, qr/^Cannot dup '\d+' \Qfor stdout: '$errstring' at ${\__FILE__}/, 'First dup() -- setting up STDOUT' );
};
protect { # fail on the second dup() -- stderr, coming in
my $count = 2;
local $when_to_fail = sub { $mode eq '>&' and !--$count }; # second dup()
eval { trap { 1 } };
like( $@, qr/^Cannot dup '\d+' \Qfor stderr: '$errstring' at ${\__FILE__}/, 'Second dup() -- setting up STDERR' );
};
protect { # fail on the third dup() -- stderr, going out
my $count = 3;
local $when_to_fail = sub { $mode eq '>&' and !--$count };
eval { trap { 1 } };
like( $@, qr/^Cannot dup '\d+' \Qfor stderr: '$errstring' at ${\__FILE__}/, 'Third dup() -- restoring STDERR' );
};
protect { # fourth dup() -- stdout, going out
my $count = 4;
local $when_to_fail = sub { $mode eq '>&' and !--$count };
eval { trap { 1 } };
like( $@, qr/^Cannot dup '\d+' \Qfor stdout: '$errstring' at ${\__FILE__}/, 'Fourth dup() -- restoring STDOUT' );
};
protect { # fail on first opening the stderr tempfile for append
my $count = 1;
local $when_to_fail = sub { $mode eq '>>' and !--$count };
eval { trap { 1 } };
like( $@, qr/^Cannot open \S+ \Qfor stdout: '$errstring' at ${\__FILE__}/, 'First append to tempfile' );
};
SKIP: {
protect {
skip 'Need PerlIO', 1 unless eval 'use PerlIO; 1';
local *STDOUT;
open STDOUT, '>', \ my $buffer;
eval { trap { 1 } };
like( $@, qr/^\QSystemSafe only works with real file descriptors; aborting at ${\__FILE__}/, 'Negative fileno' );
};
}
SKIP: {
protect {
skip 'Need IO::Scalar', 1 unless eval 'use IO::Scalar; 1';
local *STDOUT;
tie *STDOUT, 'IO::Scalar', \my $s;
eval { trap { 1 } };
like( $@, qr/^\QSystemSafe only works with real file descriptors; aborting at ${\__FILE__}/, 'Tied handle' );
};
}
|
