1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
#!/usr/bin/perl -w
BEGIN
{
chdir 't' if -d 't';
@INC = '../lib';
}
use strict;
use File::Path;
use File::Spec;
use Test::More tests => 18;
{
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 };
my $warn = '' ;
local $SIG{__WARN__} = sub { $warn = "@_" } ;
{
no warnings ;
IO->import();
is( $warn, '', "... import default, should not warn");
$warn = '' ;
}
{
local $^W = 0;
IO->import();
is( $warn, '', "... import default, should not warn");
$warn = '' ;
}
{
local $^W = 1;
IO->import();
like( $warn, qr/^Parameterless "use IO" deprecated at/,
"... import default, should warn");
$warn = '' ;
}
{
use warnings 'deprecated' ;
IO->import();
like( $warn, qr/^Parameterless "use IO" deprecated at/,
"... import default, should warn");
$warn = '' ;
}
{
use warnings ;
IO->import();
like( $warn, qr/^Parameterless "use IO" deprecated at/,
"... import default, should warn");
$warn = '' ;
}
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;
rmdir $fakedir;
}
|
