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