1*5759b3d2Safresh1#!/usr/bin/perl -w 2*5759b3d2Safresh1 3*5759b3d2Safresh1BEGIN { 4*5759b3d2Safresh1 if( $ENV{PERL_CORE} ) { 5*5759b3d2Safresh1 chdir 't'; 6*5759b3d2Safresh1 @INC = ('../lib', 'lib'); 7*5759b3d2Safresh1 } 8*5759b3d2Safresh1 else { 9*5759b3d2Safresh1 unshift @INC, 't/lib'; 10*5759b3d2Safresh1 } 11*5759b3d2Safresh1} 12*5759b3d2Safresh1 13*5759b3d2Safresh1use strict; 14*5759b3d2Safresh1use Test::More tests => 11; 15*5759b3d2Safresh1use TieOut; 16*5759b3d2Safresh1 17*5759b3d2Safresh1ok( !Test::Builder->is_fh("foo"), 'string is not a filehandle' ); 18*5759b3d2Safresh1ok( !Test::Builder->is_fh(''), 'empty string' ); 19*5759b3d2Safresh1ok( !Test::Builder->is_fh(undef), 'undef' ); 20*5759b3d2Safresh1 21*5759b3d2Safresh1ok( open(FILE, '>foo') ); 22*5759b3d2Safresh1END { close FILE; 1 while unlink 'foo' } 23*5759b3d2Safresh1 24*5759b3d2Safresh1ok( Test::Builder->is_fh(*FILE) ); 25*5759b3d2Safresh1ok( Test::Builder->is_fh(\*FILE) ); 26*5759b3d2Safresh1ok( Test::Builder->is_fh(*FILE{IO}) ); 27*5759b3d2Safresh1 28*5759b3d2Safresh1tie *OUT, 'TieOut'; 29*5759b3d2Safresh1ok( Test::Builder->is_fh(*OUT) ); 30*5759b3d2Safresh1ok( Test::Builder->is_fh(\*OUT) ); 31*5759b3d2Safresh1 32*5759b3d2Safresh1SKIP: { 33*5759b3d2Safresh1 skip "*TIED_HANDLE{IO} doesn't work in this perl", 1 34*5759b3d2Safresh1 unless defined *OUT{IO}; 35*5759b3d2Safresh1 ok( Test::Builder->is_fh(*OUT{IO}) ); 36*5759b3d2Safresh1} 37*5759b3d2Safresh1 38*5759b3d2Safresh1 39*5759b3d2Safresh1package Lying::isa; 40*5759b3d2Safresh1 41*5759b3d2Safresh1sub isa { 42*5759b3d2Safresh1 my $self = shift; 43*5759b3d2Safresh1 my $parent = shift; 44*5759b3d2Safresh1 45*5759b3d2Safresh1 return 1 if $parent eq 'IO::Handle'; 46*5759b3d2Safresh1} 47*5759b3d2Safresh1 48*5759b3d2Safresh1::ok( Test::Builder->is_fh(bless {}, "Lying::isa")); 49