Commit | Line | Data |
3bb002d7 |
1 | #!/usr/bin/perl -w |
2 | |
3 | BEGIN |
4 | { |
5 | chdir 't' if -d 't'; |
6 | @INC = '../lib'; |
f788fe6d |
7 | require Config; |
fedc905f |
8 | if ($Config::Config{'extensions'} !~ /\bSocket\b/) { |
9 | print "1..0 # Skip: Socket not built - IO.pm uses Socket"; |
10 | exit 0; |
11 | } |
3bb002d7 |
12 | } |
13 | |
14 | use strict; |
15 | use File::Path; |
16 | use File::Spec; |
b8370f2a |
17 | use Test::More tests => 18; |
3bb002d7 |
18 | |
19 | { |
20 | local $INC{'XSLoader.pm'} = 1; |
21 | local *XSLoader::load; |
22 | |
23 | my @load; |
24 | *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 | |
35 | my @default = map { "IO/$_.pm" } qw( Handle Seekable File Pipe Socket Dir ); |
36 | delete @INC{ @default }; |
37 | |
b8370f2a |
38 | my $warn = '' ; |
39 | local $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(); |
1d94a06f |
58 | like( $warn, qr/^Parameterless "use IO" deprecated at/, |
b8370f2a |
59 | "... import default, should warn"); |
60 | $warn = '' ; |
61 | } |
62 | |
63 | { |
64 | use warnings 'deprecated' ; |
65 | IO->import(); |
1d94a06f |
66 | like( $warn, qr/^Parameterless "use IO" deprecated at/, |
b8370f2a |
67 | "... import default, should warn"); |
68 | $warn = '' ; |
69 | } |
70 | |
71 | { |
72 | use warnings ; |
73 | IO->import(); |
1d94a06f |
74 | like( $warn, qr/^Parameterless "use IO" deprecated at/, |
b8370f2a |
75 | "... import default, should warn"); |
76 | $warn = '' ; |
77 | } |
78 | |
3bb002d7 |
79 | foreach my $default (@default) |
80 | { |
81 | ok( exists $INC{ $default }, "... import should default load $default" ); |
82 | } |
83 | |
84 | eval { IO->import( 'nothere' ) }; |
85 | like( $@, qr/Can.t locate IO.nothere\.pm/, '... croaking on any error' ); |
86 | |
87 | my $fakedir = File::Spec->catdir( 'lib', 'IO' ); |
88 | my $fakemod = File::Spec->catfile( $fakedir, 'fakemod.pm' ); |
89 | |
90 | my $flag; |
91 | if ( -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 | |
115 | SKIP: |
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 | |
123 | END |
124 | { |
125 | 1 while unlink $fakemod; |
9a119d77 |
126 | rmdir $fakedir; |
3bb002d7 |
127 | } |