git.maemo.org Git - pkg-perl/blob - deb-src/libfile-chdir-perl/libfile-chdir-perl-0.06/t/chdir.t

   1 #!/usr/bin/perl -Tw
   2
   3 use strict;
   4 use lib qw(t/lib);
   5 use Test::More tests => 6;
   6
   7 BEGIN { use_ok('File::chdir') }
   8
   9 use Cwd;
  10
  11 # Don't want to depend on File::Spec::Functions
  12 sub catdir { File::Spec->catdir(@_); }
  13
  14 my($cwd) = getcwd =~ /(.*)/;  # detaint otherwise nothing's gonna work
  15
  16 # First, let's try normal chdir()
  17 {
  18     chdir('t');
  19     ::is( getcwd, catdir($cwd,'t'), 'void chdir still works' );
  20
  21     chdir($cwd);    # reset
  22
  23     if( chdir('t') ) {
  24         1;
  25     }
  26     else {
  27         ::fail('chdir() failed completely in boolean context!');
  28     }
  29     ::is( getcwd, catdir($cwd,'t'),  '  even in boolean context' );
  30 }
  31
  32 ::is( getcwd, catdir($cwd,'t'), '  unneffected by blocks' );
  33
  34
  35 # Ok, reset ourself for the real test.
  36 chdir($cwd) or die $!;
  37
  38 {
  39     local $ENV{HOME} = 't';
  40     chdir;
  41     ::is( getcwd, catdir($cwd, 't'), 'chdir() with no args' );
  42     ::is( $CWD, catdir($cwd, 't'), '  $CWD follows' );
  43 }
  44
  45 # Final chdir() back to the original or we confuse the debugger.
  46 chdir($cwd);