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