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; |
12 | use Test::More tests => 13; |
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 | |
33 | IO->import(); |
34 | foreach my $default (@default) |
35 | { |
36 | ok( exists $INC{ $default }, "... import should default load $default" ); |
37 | } |
38 | |
39 | eval { IO->import( 'nothere' ) }; |
40 | like( $@, qr/Can.t locate IO.nothere\.pm/, '... croaking on any error' ); |
41 | |
42 | my $fakedir = File::Spec->catdir( 'lib', 'IO' ); |
43 | my $fakemod = File::Spec->catfile( $fakedir, 'fakemod.pm' ); |
44 | |
45 | my $flag; |
46 | if ( -d $fakedir or mkpath( $fakedir )) |
47 | { |
48 | if (open( OUT, ">$fakemod")) |
49 | { |
50 | (my $package = <<' END_HERE') =~ tr/\t//d; |
51 | package IO::fakemod; |
52 | |
53 | sub import { die "Do not import!\n" } |
54 | |
55 | sub exists { 1 } |
56 | |
57 | 1; |
58 | END_HERE |
59 | |
60 | print OUT $package; |
61 | } |
62 | |
63 | if (close OUT) |
64 | { |
65 | $flag = 1; |
66 | push @INC, 'lib'; |
67 | } |
68 | } |
69 | |
70 | SKIP: |
71 | { |
72 | skip("Could not write to disk", 2 ) unless $flag; |
73 | eval { IO->import( 'fakemod' ) }; |
74 | ok( IO::fakemod::exists(), 'import() should import IO:: modules by name' ); |
75 | is( $@, '', '... and should not call import() on imported modules' ); |
76 | } |
77 | |
78 | END |
79 | { |
80 | 1 while unlink $fakemod; |
81 | } |