Add tests for IO.pm

Message-ID: <20021022033253.57952.qmail@onion.perl.org>

p4raw-id: //depot/perl@18061

diff --git a/MANIFEST b/MANIFEST
index c8aea96..ffa3329 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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 (file)
index 0000000..d3f87a1
--- /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;
+}