diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | ext/IO/lib/IO/t/IO.t | 81 |
2 files changed, 82 insertions, 0 deletions
@@ -426,6 +426,7 @@ ext/I18N/Langinfo/Makefile.PL I18N::Langinfo ext/IO/ChangeLog IO perl module change log ext/IO/hints/sco.pl Hint for IO for named architecture ext/IO/IO.pm Top-level interface to IO::* classes +ext/IO/lib/IO/t/IO.t See if IO works ext/IO/IO.xs IO extension external subroutines ext/IO/lib/IO/Dir.pm IO directory reading package ext/IO/lib/IO/File.pm IO file handle package diff --git a/ext/IO/lib/IO/t/IO.t b/ext/IO/lib/IO/t/IO.t new file mode 100644 index 0000000000..d3f87a12f0 --- /dev/null +++ b/ext/IO/lib/IO/t/IO.t @@ -0,0 +1,81 @@ +#!/usr/bin/perl -w + +BEGIN +{ + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use strict; +use File::Path; +use File::Spec; +use Test::More tests => 13; + +{ + local $INC{'XSLoader.pm'} = 1; + local *XSLoader::load; + + my @load; + *XSLoader::load = sub { + push @load, \@_; + }; + + # use_ok() calls import, which we do not want to do + require_ok( 'IO' ); + ok( @load, 'IO should call XSLoader::load()' ); + is( $load[0][0], 'IO', '... loading the IO library' ); + is( $load[0][1], $IO::VERSION, '... with the current .pm version' ); +} + +my @default = map { "IO/$_.pm" } qw( Handle Seekable File Pipe Socket Dir ); +delete @INC{ @default }; + +IO->import(); +foreach my $default (@default) +{ + ok( exists $INC{ $default }, "... import should default load $default" ); +} + +eval { IO->import( 'nothere' ) }; +like( $@, qr/Can.t locate IO.nothere\.pm/, '... croaking on any error' ); + +my $fakedir = File::Spec->catdir( 'lib', 'IO' ); +my $fakemod = File::Spec->catfile( $fakedir, 'fakemod.pm' ); + +my $flag; +if ( -d $fakedir or mkpath( $fakedir )) +{ + if (open( OUT, ">$fakemod")) + { + (my $package = <<' END_HERE') =~ tr/\t//d; + package IO::fakemod; + + sub import { die "Do not import!\n" } + + sub exists { 1 } + + 1; + END_HERE + + print OUT $package; + } + + if (close OUT) + { + $flag = 1; + push @INC, 'lib'; + } +} + +SKIP: +{ + skip("Could not write to disk", 2 ) unless $flag; + eval { IO->import( 'fakemod' ) }; + ok( IO::fakemod::exists(), 'import() should import IO:: modules by name' ); + is( $@, '', '... and should not call import() on imported modules' ); +} + +END +{ + 1 while unlink $fakemod; +} |