1#!/usr/bin/perl -w 2 3BEGIN 4{ 5 chdir 't' if -d 't'; 6 @INC = '../lib'; 7} 8 9use strict; 10use File::Path; 11use File::Spec; 12use Test::More tests => 18; 13 14{ 15 local $INC{'XSLoader.pm'} = 1; 16 local *XSLoader::load; 17 18 my @load; 19 *XSLoader::load = sub { 20 push @load, \@_; 21 }; 22 23 # use_ok() calls import, which we do not want to do 24 require_ok( 'IO' ); 25 ok( @load, 'IO should call XSLoader::load()' ); 26 is( $load[0][0], 'IO', '... loading the IO library' ); 27 is( $load[0][1], $IO::VERSION, '... with the current .pm version' ); 28} 29 30my @default = map { "IO/$_.pm" } qw( Handle Seekable File Pipe Socket Dir ); 31delete @INC{ @default }; 32 33my $warn = '' ; 34local $SIG{__WARN__} = sub { $warn = "@_" } ; 35 36{ 37 no warnings ; 38 IO->import(); 39 is( $warn, '', "... import default, should not warn"); 40 $warn = '' ; 41} 42 43{ 44 local $^W = 0; 45 IO->import(); 46 is( $warn, '', "... import default, should not warn"); 47 $warn = '' ; 48} 49 50{ 51 local $^W = 1; 52 IO->import(); 53 like( $warn, qr/^Parameterless "use IO" deprecated at/, 54 "... import default, should warn"); 55 $warn = '' ; 56} 57 58{ 59 use warnings 'deprecated' ; 60 IO->import(); 61 like( $warn, qr/^Parameterless "use IO" deprecated at/, 62 "... import default, should warn"); 63 $warn = '' ; 64} 65 66{ 67 use warnings ; 68 IO->import(); 69 like( $warn, qr/^Parameterless "use IO" deprecated at/, 70 "... import default, should warn"); 71 $warn = '' ; 72} 73 74foreach my $default (@default) 75{ 76 ok( exists $INC{ $default }, "... import should default load $default" ); 77} 78 79eval { IO->import( 'nothere' ) }; 80like( $@, qr/Can.t locate IO.nothere\.pm/, '... croaking on any error' ); 81 82my $fakedir = File::Spec->catdir( 'lib', 'IO' ); 83my $fakemod = File::Spec->catfile( $fakedir, 'fakemod.pm' ); 84 85my $flag; 86if ( -d $fakedir or mkpath( $fakedir )) 87{ 88 if (open( OUT, ">$fakemod")) 89 { 90 (my $package = <<' END_HERE') =~ tr/\t//d; 91 package IO::fakemod; 92 93 sub import { die "Do not import!\n" } 94 95 sub exists { 1 } 96 97 1; 98 END_HERE 99 100 print OUT $package; 101 } 102 103 if (close OUT) 104 { 105 $flag = 1; 106 push @INC, 'lib'; 107 } 108} 109 110SKIP: 111{ 112 skip("Could not write to disk", 2 ) unless $flag; 113 eval { IO->import( 'fakemod' ) }; 114 ok( IO::fakemod::exists(), 'import() should import IO:: modules by name' ); 115 is( $@, '', '... and should not call import() on imported modules' ); 116} 117 118END 119{ 120 1 while unlink $fakemod; 121 rmdir $fakedir; 122} 123