ext/IO/t/IO.t

   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 => 18;
  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 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();
  53     like( $warn, qr/^Parameterless "use IO" deprecated at/,
  54               "... import default, should warn");
  55     $warn = '' ;
  56 }
  57
  58 {
  59     use warnings 'deprecated' ;
  60     IO->import();
  61     like( $warn, qr/^Parameterless "use IO" deprecated at/,
  62               "... import default, should warn");
  63     $warn = '' ;
  64 }
  65
  66 {
  67     use warnings ;
  68     IO->import();
  69     like( $warn, qr/^Parameterless "use IO" deprecated at/,
  70               "... import default, should warn");
  71     $warn = '' ;
  72 }
  73
  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;
 121 }