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 my $xsl = \&XSLoader::load; 25 local *XSLoader::load = sub { 26 push @load, \@_; 27 &$xsl(@_); 28 }; 29 30 # use_ok() calls import, which we do not want to do 31 require_ok( 'IO' ); 32 ok( @load, 'IO should call XSLoader::load()' ); 33 is( $load[0][0], 'IO', '... loading the IO library' ); 34 is( $load[0][1], $IO::VERSION, '... with the current .pm version' ); 35} 36 37my @default = map { "IO/$_.pm" } qw( Handle Seekable File Pipe Socket Dir ); 38delete @INC{ @default }; 39 40my $warn = '' ; 41local $SIG{__WARN__} = sub { $warn = "@_" } ; 42 43{ 44 no warnings ; 45 IO->import(); 46 is( $warn, '', "... import default, should not warn"); 47 $warn = '' ; 48} 49 50{ 51 local $^W = 0; 52 no if $^V >= 5.17.4, warnings => "deprecated"; 53 IO->import(); 54 is( $warn, '', "... import default, should not warn"); 55 $warn = '' ; 56} 57 58{ 59 local $^W = 1; 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 'deprecated' ; 68 IO->import(); 69 like( $warn, qr/^Parameterless "use IO" deprecated at/, 70 "... import default, should warn"); 71 $warn = '' ; 72} 73 74{ 75 use warnings ; 76 IO->import(); 77 like( $warn, qr/^Parameterless "use IO" deprecated at/, 78 "... import default, should warn"); 79 $warn = '' ; 80} 81 82foreach my $default (@default) 83{ 84 ok( exists $INC{ $default }, "... import should default load $default" ); 85} 86 87eval { IO->import( 'nothere' ) }; 88like( $@, qr/Can.t locate IO.nothere\.pm/, '... croaking on any error' ); 89 90my $fakedir = File::Spec->catdir( 'lib', 'IO' ); 91my $fakemod = File::Spec->catfile( $fakedir, 'fakemod.pm' ); 92 93my $flag; 94if ( -d $fakedir or mkpath( $fakedir )) 95{ 96 if (open( OUT, '>', $fakemod )) 97 { 98 (my $package = <<' END_HERE') =~ tr/\t//d; 99 package IO::fakemod; 100 101 sub import { die "Do not import!\n" } 102 103 sub exists { 1 } 104 105 1; 106 END_HERE 107 108 print OUT $package; 109 } 110 111 if (close OUT) 112 { 113 $flag = 1; 114 push @INC, 'lib'; 115 } 116} 117 118SKIP: 119{ 120 skip("Could not write to disk", 2 ) unless $flag; 121 eval { IO->import( 'fakemod' ) }; 122 ok( IO::fakemod::exists(), 'import() should import IO:: modules by name' ); 123 is( $@, '', '... and should not call import() on imported modules' ); 124} 125 126END 127{ 128 1 while unlink $fakemod; 129 rmdir $fakedir; 130} 131