1#!./perl 2 3BEGIN { 4 unless (-d 'blib') { 5 chdir 't' if -d 't'; 6 @INC = '../lib'; 7 require Config; import Config; 8 keys %Config; # Silence warning 9 if ($Config{extensions} !~ /\bList\/Util\b/) { 10 print "1..0 # Skip: List::Util was not built\n"; 11 exit 0; 12 } 13 } 14} 15 16use strict; 17 18use Test::More tests => 21; 19use Scalar::Util qw(openhandle); 20 21ok(defined &openhandle, 'defined'); 22 23{ 24 my $fh = \*STDERR; 25 is(openhandle($fh), $fh, 'STDERR'); 26 27 is(fileno(openhandle(*STDERR)), fileno(STDERR), 'fileno(STDERR)'); 28} 29 30{ 31 use vars qw(*CLOSED); 32 is(openhandle(*CLOSED), undef, 'closed'); 33} 34 35SKIP: { 36 skip "3-arg open only on 5.6 or later", 1 if $]<5.006; 37 38 open my $fh, "<", $0; 39 skip "could not open $0 for reading: $!", 2 unless $fh; 40 is(openhandle($fh), $fh, "works with indirect filehandles"); 41 close($fh); 42 is(openhandle($fh), undef, "works with indirect filehandles"); 43} 44 45SKIP: { 46 skip "in-memory files only on 5.8 or later", 2 if $]<5.008; 47 48 open my $fh, "<", \"in-memory file"; 49 skip "could not open in-memory file: $!", 2 unless $fh; 50 is(openhandle($fh), $fh, "works with in-memory files"); 51 close($fh); 52 is(openhandle($fh), undef, "works with in-memory files"); 53} 54 55ok(openhandle(\*DATA), "works for \*DATA"); 56ok(openhandle(*DATA), "works for *DATA"); 57ok(openhandle(*DATA{IO}), "works for *DATA{IO}"); 58 59{ 60 require IO::Handle; 61 my $fh = IO::Handle->new_from_fd(fileno(*STDERR), 'w'); 62 skip "new_from_fd(fileno(*STDERR)) failed", 2 unless $fh; 63 ok(openhandle($fh), "works for IO::Handle objects"); 64 65 ok(!openhandle(IO::Handle->new), "unopened IO::Handle"); 66} 67 68{ 69 require IO::File; 70 my $fh = IO::File->new; 71 $fh->open("< $0") 72 or skip "could not open $0: $!", 3; 73 ok(openhandle($fh), "works for IO::File objects"); 74 close($fh); 75 ok(!openhandle($fh), "works for IO::File objects"); 76 77 ok(!openhandle(IO::File->new), "unopened IO::File" ); 78} 79 80SKIP: { 81 skip( "Tied handles only on 5.8 or later", 2) if $]<5.008; 82 83 use vars qw(*H); 84 85 package My::Tie; 86 require Tie::Handle; 87 @My::Tie::ISA = qw(Tie::Handle); 88 sub TIEHANDLE { bless {} } 89 90 package main; 91 tie *H, 'My::Tie'; 92 ok(openhandle(*H), "tied handles are always ok"); 93 ok(openhandle(\*H), "tied handle refs are always ok"); 94} 95 96ok !openhandle(undef), "undef is not a filehandle"; 97ok !openhandle("STDIN"), "strings are not filehandles"; 98ok !openhandle(0), "integers are not filehandles"; 99 100 101__DATA__ 102