1# File::pushd - check module loading and create testing directory 2use strict; 3#use warnings; 4 5use Test::More 0.96; 6use File::Path 'rmtree'; 7use File::Basename 'dirname'; 8use Cwd 'abs_path'; 9use File::Spec::Functions qw( catdir curdir updir canonpath rootdir ); 10use File::Temp; 11use Config '%Config'; 12 13# abs_path necessary to pick up the volume on Win32, e.g. C:\ 14sub absdir { canonpath( abs_path( shift || curdir() ) ); } 15 16#--------------------------------------------------------------------------# 17# Test import 18#--------------------------------------------------------------------------# 19 20BEGIN { use_ok('File::pushd'); } 21can_ok( 'main', 'pushd', 'tempd' ); 22 23#--------------------------------------------------------------------------# 24# Setup 25#--------------------------------------------------------------------------# 26 27my ( $new_dir, $temp_dir, $err ); 28my $original_dir = absdir(); 29my $target_dir = 't'; 30my $expected_dir = absdir( catdir( $original_dir, $target_dir ) ); 31my $nonexistant = 'DFASDFASDFASDFAS'; 32 33#--------------------------------------------------------------------------# 34# Test error handling on bad target 35#--------------------------------------------------------------------------# 36 37eval { $new_dir = pushd($nonexistant) }; 38$err = $@; 39like( $@, '/\\ACan\'t/', "pushd to nonexistant directory croaks" ); 40 41#--------------------------------------------------------------------------# 42# Test changing to relative path directory 43#--------------------------------------------------------------------------# 44 45$new_dir = pushd($target_dir); 46 47isa_ok( $new_dir, 'File::pushd' ); 48 49is( absdir(), $expected_dir, "change directory on pushd (relative path)" ); 50 51#--------------------------------------------------------------------------# 52# Test stringification 53#--------------------------------------------------------------------------# 54 55is( "$new_dir", $expected_dir, "object stringifies" ); 56 57#--------------------------------------------------------------------------# 58# Test reverting directory 59#--------------------------------------------------------------------------# 60 61undef $new_dir; 62 63is( absdir(), $original_dir, "revert directory when variable goes out of scope" ); 64 65#--------------------------------------------------------------------------# 66 67# Test changing to absolute path directory and reverting 68#--------------------------------------------------------------------------# 69 70$new_dir = pushd($expected_dir); 71is( absdir(), $expected_dir, "change directory on pushd (absolute path)" ); 72 73undef $new_dir; 74is( absdir(), $original_dir, "revert directory when variable goes out of scope" ); 75 76#--------------------------------------------------------------------------# 77# Test changing upwards 78#--------------------------------------------------------------------------# 79 80$expected_dir = absdir( updir() ); 81$new_dir = pushd( updir() ); 82 83is( absdir(), $expected_dir, "change directory on pushd (upwards)" ); 84undef $new_dir; 85is( absdir(), $original_dir, "revert directory when variable goes out of scope" ); 86 87#--------------------------------------------------------------------------# 88# Test changing to root 89#--------------------------------------------------------------------------# 90 91$new_dir = pushd( rootdir() ); 92 93is( absdir(), absdir( rootdir() ), "change directory on pushd (rootdir)" ); 94undef $new_dir; 95is( absdir(), $original_dir, "revert directory when variable goes out of scope" ); 96 97#--------------------------------------------------------------------------# 98# Test with options 99#--------------------------------------------------------------------------# 100 101$new_dir = pushd( $expected_dir, { untaint_pattern => qr{^([-\w./]+)$} } ); 102is( absdir(), $expected_dir, "change directory on pushd (custom untaint)" ); 103undef $new_dir; 104is( absdir(), $original_dir, "revert directory when variable goes out of scope" ); 105 106#--------------------------------------------------------------------------# 107# Test changing in place 108#--------------------------------------------------------------------------# 109 110$new_dir = pushd(); 111 112is( absdir(), $original_dir, "pushd with no argument doesn't change directory" ); 113chdir "t"; 114is( 115 absdir(), 116 absdir( catdir( $original_dir, "t" ) ), 117 "changing manually to another directory" 118); 119undef $new_dir; 120is( absdir(), $original_dir, "revert directory when variable goes out of scope" ); 121 122#--------------------------------------------------------------------------# 123# Test changing to temporary dir 124#--------------------------------------------------------------------------# 125 126$new_dir = tempd(); 127$temp_dir = "$new_dir"; 128 129ok( absdir() ne $original_dir, "tempd changes to new temporary directory" ); 130 131undef $new_dir; 132is( absdir(), $original_dir, "revert directory when variable goes out of scope" ); 133 134ok( !-e $temp_dir, "temporary directory removed" ); 135 136#--------------------------------------------------------------------------# 137# Test changing to temporary dir but preserving it 138#--------------------------------------------------------------------------# 139 140$new_dir = tempd(); 141$temp_dir = "$new_dir"; 142 143ok( absdir() ne $original_dir, "tempd changes to new temporary directory" ); 144 145ok( $new_dir->preserve(1), "mark temporary directory for preservation" ); 146 147undef $new_dir; 148is( absdir(), $original_dir, "revert directory when variable goes out of scope" ); 149 150ok( -e $temp_dir, "temporary directory preserved" ); 151 152ok( rmtree($temp_dir), "temporary directory manually cleaned up" ); 153 154#--------------------------------------------------------------------------# 155# Test changing to temporary dir but preserving it *outside the process* 156#--------------------------------------------------------------------------# 157 158my $program_file = File::Temp->new(); 159my $lib = absdir("lib"); 160$lib =~ s{\\}{/}g; 161 162print {$program_file} <<"END_PROGRAM"; 163use lib "$lib"; 164use File::pushd; 165my \$tempd = tempd() or exit; 166\$tempd->preserve(1); 167print "\$tempd\n"; 168END_PROGRAM 169 170$program_file->close; 171 172# for when I manually test with "perl -t", must untaint things 173for my $key (qw(IFS CDPATH ENV BASH_ENV PATH)) { 174 next unless defined $ENV{$key}; 175 $ENV{$key} =~ /^(.*)$/; 176 $ENV{$key} = $1; 177} 178 179$temp_dir = `$^X $program_file`; 180 181chomp($temp_dir); 182 183$temp_dir =~ /(.*)/; 184my $clean_tmp = $1; 185 186ok( length $clean_tmp, "got a temp directory name from subproces" ); 187 188ok( -e $clean_tmp, "temporary directory preserved outside subprocess" ); 189 190ok( rmtree($clean_tmp), "temporary directory manually cleaned up" ); 191 192#--------------------------------------------------------------------------# 193# Test changing to temporary dir, preserve it, then revert 194#--------------------------------------------------------------------------# 195 196$new_dir = tempd(); 197$temp_dir = "$new_dir"; 198 199ok( absdir() ne $original_dir, "tempd changes to new temporary directory" ); 200 201ok( $new_dir->preserve, "mark temporary directory for preservation" ); 202ok( !$new_dir->preserve(0), "mark temporary directory for removal" ); 203 204undef $new_dir; 205is( absdir(), $original_dir, "revert directory when variable goes out of scope" ); 206 207ok( !-e $temp_dir, "temporary directory removed" ); 208#--------------------------------------------------------------------------# 209# Test preserve failing on non temp directory 210#--------------------------------------------------------------------------# 211 212$new_dir = pushd( catdir( $original_dir, $target_dir ) ); 213 214is( 215 absdir(), 216 absdir( catdir( $original_dir, $target_dir ) ), 217 "change directory on pushd" 218); 219$temp_dir = "$new_dir"; 220 221ok( $new_dir->preserve, "regular pushd is automatically preserved" ); 222ok( $new_dir->preserve(0), "can't mark regular pushd for deletion" ); 223 224undef $new_dir; 225is( absdir(), $original_dir, "revert directory when variable goes out of scope" ); 226 227ok( -e $expected_dir, "original directory not removed" ); 228 229#--------------------------------------------------------------------------# 230# Test removing temp directory by owner process 231#--------------------------------------------------------------------------# 232if ( $Config{d_fork} ) { 233 my $new_dir = tempd(); 234 my $temp_dir = "$new_dir"; 235 my $pid = fork; 236 die "Can't fork: $!" unless defined $pid; 237 if ($pid == 0) { 238 exit; 239 } 240 wait; 241 ok( -e $temp_dir, "temporary directory not removed by child process" ); 242 undef $new_dir; 243 ok( !-e $temp_dir, "temporary directory removed by owner process" ); 244} 245 246done_testing; 247