open my $output, '>-' or die $!;
####
open my $output, '>&', *STDOUT or die $!;
##
##
open my $output, '>-' or die $!;
close *STDOUT;
print {$output} "This fails with Bad file descriptor";
##
##
open my $output, '>&', *STDOUT or die $!;
close *STDOUT;
print {$output} "This prints OK\n";
##
##
my $output = *STDOUT;
##
##
close STDOUT;
print {$output}
'Besides Bad file descriptor, this will also warn "print() on closed filehandle STDOUT"';
##
##
#!/usr/bin/perl
use strict;
use warnings;
sub original {
open my $output, '>-' or die $!;
$output
}
sub assign {
my $output = *STDOUT;
$output
}
sub dup {
open my $output, '>&', *STDOUT or die $!;
$output
}
sub fn {
open my $output, '>>&=', *STDOUT->fileno or die $!;
$output
}
use Test::More;
sub test {
my ($open) = @_;
my @W;
local $SIG{__WARN__} = sub { push @W, @_ };
my $output = $open->();
close *STDOUT;
my $v = print {$output} "abc\n";
isnt $v, 1, 'fails';
like $!, qr/Bad file descriptor/, 'Exception';
is scalar @W, 0, 'no warnings';
chomp, diag "($_)" for @W;
done_testing();
}
my %dispatch = (1 => \&original,
2 => \&assign,
3 => \&dup,
4 => \&fn);
my $what = shift;
my $code = $dispatch{$what} or die 'Not associated';
test($code);