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