dist/ExtUtils-Install/t/Install.t

   1 #!/usr/bin/perl -w
   2
   3 # Test ExtUtils::Install.
   4
   5 BEGIN {
   6     unshift @INC, 't/lib';
   7 }
   8
   9 use strict;
  10 use TieOut;
  11 use File::Path;
  12 use File::Spec;
  13 use File::Temp qw[tempdir];
  14
  15 use Test::More tests => 60;
  16
  17 use MakeMaker::Test::Setup::BFD;
  18
  19 BEGIN {
  20   local $ENV{PERL_INSTALL_QUIET};
  21   use_ok('ExtUtils::Install');
  22 }
  23 # ensure the env doesn't pollute our tests
  24 local $ENV{EU_INSTALL_ALWAYS_COPY};
  25 local $ENV{EU_ALWAYS_COPY};
  26
  27 # Check exports.
  28 foreach my $func (qw(install uninstall pm_to_blib install_default)) {
  29     can_ok(__PACKAGE__, $func);
  30 }
  31
  32 my $tmpdir = tempdir( DIR => 't', CLEANUP => 1 );
  33 chdir $tmpdir;
  34
  35 ok( setup_recurs(), 'setup' );
  36 END {
  37     ok( chdir File::Spec->updir, 'chdir ..');
  38     ok( teardown_recurs(), 'teardown' );
  39 }
  40
  41 chdir 'Big-Dummy';
  42
  43 my $stdout = tie *STDOUT, 'TieOut';
  44 pm_to_blib( { 'lib/Big/Dummy.pm' => 'blib/lib/Big/Dummy.pm' },
  45             'blib/lib/auto'
  46           );
  47 END { rmtree 'blib' }
  48
  49 ok( -d 'blib/lib',              'pm_to_blib created blib dir' );
  50 ok( -r 'blib/lib/Big/Dummy.pm', '  copied .pm file' );
  51 ok( -r 'blib/lib/auto',         '  created autosplit dir' );
  52 is( $stdout->read, "cp lib/Big/Dummy.pm blib/lib/Big/Dummy.pm\n" );
  53
  54
  55 pm_to_blib( { 'lib/Big/Dummy.pm' => 'blib/lib/Big/Dummy.pm' },
  56             'blib/lib/auto'
  57           );
  58 ok( -d 'blib/lib',              'second run, blib dir still there' );
  59 ok( -r 'blib/lib/Big/Dummy.pm', '  .pm file still there' );
  60 ok( -r 'blib/lib/auto',         '  autosplit still there' );
  61 is( $stdout->read, "Skip blib/lib/Big/Dummy.pm (unchanged)\n" );
  62
  63
  64 install( { 'blib/lib' => 'install-test/lib/perl',
  65            read   => 'install-test/packlist',
  66            write  => 'install-test/packlist'
  67          },
  68        0, 1);
  69 ok( ! -d 'install-test/lib/perl',        'install made dir (dry run)');
  70 ok( ! -r 'install-test/lib/perl/Big/Dummy.pm',
  71                                          '  .pm file installed (dry run)');
  72 ok( ! -r 'install-test/packlist',        '  packlist exists (dry run)');
  73
  74 install( { 'blib/lib' => 'install-test/lib/perl',
  75            read   => 'install-test/packlist',
  76            write  => 'install-test/packlist'
  77          } );
  78 ok( -d 'install-test/lib/perl',                 'install made dir' );
  79 ok( -r 'install-test/lib/perl/Big/Dummy.pm',    '  .pm file installed' );
  80 ok(!-r 'install-test/lib/perl/Big/Dummy.SKIP',  '  ignored .SKIP file' );
  81 ok( -r 'install-test/packlist',                 '  packlist exists' );
  82
  83 open(PACKLIST, 'install-test/packlist' );
  84 my %packlist = map { chomp;  ($_ => 1) } <PACKLIST>;
  85 close PACKLIST;
  86
  87 # On case-insensitive filesystems (ie. VMS), the keys of the packlist might
  88 # be lowercase. :(
  89 my $native_dummy = File::Spec->catfile(qw(install-test lib perl Big Dummy.pm));
  90 is( keys %packlist, 1 );
  91 is( lc((keys %packlist)[0]), lc $native_dummy, 'packlist written' );
  92
  93
  94 # Test UNINST=1 preserving same versions in other dirs.
  95 install( { 'blib/lib' => 'install-test/other_lib/perl',
  96            read   => 'install-test/packlist',
  97            write  => 'install-test/packlist'
  98          },
  99        0, 0, 1);
 100 ok( -d 'install-test/other_lib/perl',        'install made other dir' );
 101 ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', '  .pm file installed' );
 102 ok( -r 'install-test/packlist',              '  packlist exists' );
 103 ok( -r 'install-test/lib/perl/Big/Dummy.pm', '  UNINST=1 preserved same' );
 104
 105
 106 chmod 0644, 'blib/lib/Big/Dummy.pm' or die $!;
 107 open(DUMMY, ">>blib/lib/Big/Dummy.pm") or die $!;
 108 print DUMMY "Extra stuff\n";
 109 close DUMMY;
 110
 111
 112 # Test UNINST=0 does not remove other versions in other dirs.
 113 {
 114   ok( -r 'install-test/lib/perl/Big/Dummy.pm', 'different install exists' );
 115
 116   local @INC = ('install-test/lib/perl');
 117   local $ENV{PERL5LIB} = '';
 118   install( { 'blib/lib' => 'install-test/other_lib/perl',
 119            read   => 'install-test/packlist',
 120            write  => 'install-test/packlist'
 121          },
 122        0, 0, 0);
 123   ok( -d 'install-test/other_lib/perl',        'install made other dir' );
 124   ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', '  .pm file installed' );
 125   ok( -r 'install-test/packlist',              '  packlist exists' );
 126   ok( -r 'install-test/lib/perl/Big/Dummy.pm',
 127                                              '  UNINST=0 left different' );
 128 }
 129
 130 # Test UNINST=1 only warning when failing to remove an irrelevant shadow file
 131 {
 132   my $tfile='install-test/lib/perl/Big/Dummy.pm';
 133   local $ExtUtils::Install::Testing = $tfile;
 134   local @INC = ('install-test/other_lib/perl','install-test/lib/perl');
 135   local $ENV{PERL5LIB} = '';
 136   ok( -r $tfile, 'different install exists' );
 137   my @warn;
 138   local $SIG{__WARN__}=sub { push @warn, @_; return };
 139   my $ok=eval {
 140     install( { 'blib/lib' => 'install-test/other_lib/perl',
 141            read   => 'install-test/packlist',
 142            write  => 'install-test/packlist'
 143          },
 144        0, 0, 1);
 145     1
 146   };
 147   ok($ok,'  we didnt die');
 148   ok(0+@warn,"  we did warn");
 149   ok( -d 'install-test/other_lib/perl',        'install made other dir' );
 150   ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', '  .pm file installed' );
 151   ok( -r 'install-test/packlist',              '  packlist exists' );
 152   ok( -r $tfile, '  UNINST=1 failed to remove different' );
 153
 154 }
 155
 156 # Test UNINST=1 dieing when failing to remove an relevant shadow file
 157 {
 158   my $tfile='install-test/lib/perl/Big/Dummy.pm';
 159   local $ExtUtils::Install::Testing = $tfile;
 160   local @INC = ('install-test/lib/perl','install-test/other_lib/perl');
 161   local $ENV{PERL5LIB} = '';
 162   ok( -r $tfile, 'different install exists' );
 163   my @warn;
 164   local $SIG{__WARN__}=sub { push @warn,@_; return };
 165   my $ok=eval {
 166     install( { 'blib/lib' => 'install-test/other_lib/perl',
 167            read   => 'install-test/packlist',
 168            write  => 'install-test/packlist'
 169          },
 170        0, 0, 1);
 171     1
 172   };
 173   ok(!$ok,'  we did die');
 174   ok(!@warn,"  we didnt warn");
 175   ok( -d 'install-test/other_lib/perl',        'install made other dir' );
 176   ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', '  .pm file installed' );
 177   ok( -r 'install-test/packlist',              '  packlist exists' );
 178   ok( -r $tfile,'  UNINST=1 failed to remove different' );
 179 }
 180
 181 # Test UNINST=1 removing other versions in other dirs.
 182 {
 183   local @INC = ('install-test/lib/perl');
 184   local $ENV{PERL5LIB} = '';
 185   install( { 'blib/lib' => 'install-test/other_lib/perl',
 186            read   => 'install-test/packlist',
 187            write  => 'install-test/packlist'
 188          },
 189        0, 0, 1);
 190   ok( -d 'install-test/other_lib/perl',        'install made other dir' );
 191   ok( -r 'install-test/other_lib/perl/Big/Dummy.pm', '  .pm file installed' );
 192   ok( -r 'install-test/packlist',              '  packlist exists' );
 193   ok( !-r 'install-test/lib/perl/Big/Dummy.pm',
 194                                              '  UNINST=1 removed different' );
 195 }
 196
 197
 198 # do a -w style test, but based on just on file perms rather than UID
 199 # (on UNIX, root sees everything as writeable)
 200
 201 sub writeable {
 202     my ($file) = @_;
 203     my @stat = stat $file;
 204     return 0 unless defined $stat[2]; # mode
 205     return $stat[2] & 0200;
 206 }
 207
 208
 209 # really this test should be run on any platform that supports
 210 # symbolic and hard links, but this representative sample should do for
 211 # now
 212
 213
 214 # check hard and symbolic links
 215
 216 SKIP: {
 217     my $has_links =
 218         $^O =~ /^(aix|bsdos|darwin|freebsd|hpux|irix|linux|openbsd|solaris)$/;
 219     skip "(sym)links not supported", 8 unless $has_links;
 220
 221     install([ from_to => { 'blib/lib/' => 'install-links',
 222                            read   => 'install-links/packlist',
 223                            write  => 'install-links/packlist'
 224                          },
 225     ]);
 226
 227     # make orig file a hard link and check that it doesn't get messed up
 228
 229     my $bigdir = 'install-links/Big';
 230     ok link("$bigdir/Dummy.pm", "$bigdir/DummyHard.pm"),
 231         'link DummyHard.pm';
 232
 233     open(my $fh, ">>", "blib/lib/Big/Dummy.pm") or die $!;
 234     print $fh "Extra stuff 2\n";
 235     close $fh;
 236
 237     install([ from_to => { 'blib/lib/' => 'install-links',
 238                            read   => 'install-links/packlist',
 239                            write  => 'install-links/packlist'
 240                          },
 241     ]);
 242
 243     ok( !writeable("$bigdir/DummyHard.pm"), 'DummyHard.pm not writeable' );
 244
 245     use File::Compare;
 246     ok(compare("$bigdir/Dummy.pm", "$bigdir/DummyHard.pm"),
 247         "hard-linked file should be different");
 248
 249     # make orig file a symlink and check that it doesn't get messed up
 250
 251     ok rename("$bigdir/Dummy.pm", "$bigdir/DummyOrig.pm"),
 252         'rename DummyOrig.pm';
 253     ok symlink('DummyOrig.pm', "$bigdir/Dummy.pm"),
 254         'symlink Dummy.pm';
 255
 256
 257     open($fh, ">>", "blib/lib/Big/Dummy.pm") or die $!;
 258     print $fh "Extra stuff 3\n";
 259     close $fh;
 260
 261     install([ from_to => { 'blib/lib/' => 'install-links',
 262                            read   => 'install-links/packlist',
 263                            write  => 'install-links/packlist'
 264                          },
 265     ]);
 266
 267     ok( !writeable("$bigdir/DummyOrig.pm"), 'DummyOrig.pm not writeable' );
 268     ok( !-l "$bigdir/Dummy.pm", 'Dummy.pm not a link' );
 269     ok(compare("$bigdir/Dummy.pm", "$bigdir/DummyOrig.pm"),
 270         "orig file should be different");
 271 }