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