ext/List-Util/t/openhan.t

   1 #!./perl
   2
   3 BEGIN {
   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
  16 use strict;
  17
  18 use Test::More tests => 14;
  19 use Scalar::Util qw(openhandle);
  20
  21 ok(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
  35 SKIP: {
  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: $!", 1 unless $fh;
  40     is(openhandle($fh), $fh, "works with indirect filehandles");
  41 }
  42
  43 SKIP: {
  44     skip "in-memory files only on 5.8 or later", 1 if $]<5.008;
  45
  46     open my $fh, "<", \"in-memory file";
  47     skip "could not open in-memory file: $!", 1 unless $fh;
  48     is(openhandle($fh), $fh, "works with in-memory files");
  49 }
  50
  51 ok(openhandle(\*DATA), "works for \*DATA");
  52 ok(openhandle(*DATA), "works for *DATA");
  53 ok(openhandle(*DATA{IO}), "works for *DATA{IO}");
  54
  55 {
  56     require IO::Handle;
  57     my $fh = IO::Handle->new_from_fd(fileno(*STDERR), 'w');
  58     skip "new_from_fd(fileno(*STDERR)) failed", 1 unless $fh;
  59     ok(openhandle($fh), "works for IO::Handle objects");
  60
  61     ok(!openhandle(IO::Handle->new), "unopened IO::Handle");
  62 }
  63
  64 {
  65     require IO::File;
  66     my $fh = IO::File->new;
  67     $fh->open("< $0")
  68         or skip "could not open $0: $!", 1;
  69     ok(openhandle($fh), "works for IO::File objects");
  70
  71     ok(!openhandle(IO::File->new), "unopened IO::File" );
  72 }
  73
  74 SKIP: {
  75     skip( "Tied handles only on 5.8 or later", 1) if $]<5.008;
  76
  77     use vars qw(*H);
  78
  79     package My::Tie;
  80     require Tie::Handle;
  81     @My::Tie::ISA = qw(Tie::Handle);
  82     sub TIEHANDLE { bless {} }
  83
  84     package main;
  85     tie *H, 'My::Tie';
  86     ok(openhandle(*H), "tied handles are always ok");
  87 }
  88
  89 __DATA__