2 # Copyright (C) 2001-2006, The Perl Foundation.
7 use lib qw( . lib ../lib ../../lib );
9 use Parrot::Test tests => 15;
14 my $MSWin32 = $^O =~ m!MSWin32!;
15 my $cygwin = $^O =~ m!cygwin!;
16 my $MSVC = grep { $PConfig{cc} eq $_ } (qw(cl cl.exe));
20 t/pmc/os.t - Files and Dirs
34 # Clean up environment on exit
35 rmdir "xpto" if -d "xpto";
36 unlink "xpto" if -f "xpto";
40 my $cwd = File::Spec->canonpath(getcwd);
41 pir_output_is( <<'CODE', <<"OUT", 'Test cwd' );
55 my $upcwd = File::Spec->canonpath(getcwd);
58 pir_output_is( <<'CODE', <<"OUT", 'Test chdir' );
86 $xpto =~ s/src([\/\\]?)$/xpto$1/;
88 pir_output_is( <<'CODE', <<"OUT", 'Test mkdir' );
115 # Test remove on a directory
116 mkdir "xpto" unless -d "xpto";
118 pir_output_is( <<'CODE', <<'OUT', 'Test rm call in a directory' );
133 ok( !-d $xpto, "Test that rm removed the directory" );
134 rmdir $xpto if -d $xpto; # this way next test doesn't fail if this one does
138 open my $X, '>', "xpto";
144 if ( $cygwin || $MSWin32 ) {
147 my @s = stat('xpto');
148 $stat = join( "\n", $s[0], @s[ 2 .. 10 ] ) . "\n";
149 pir_output_is( <<'CODE', $stat, 'Test OS.stat' );
153 $P2 = $P1."stat"($S1)
162 if $I1 == 11 goto done
174 $stat = join( "\n", stat("xpto") ) . "\n";
175 pir_output_is( <<'CODE', $stat, 'Test OS.stat' );
179 $P2 = $P1."stat"($S1)
187 if $I1 == 13 goto done
198 skip 'not implemented on windows yet', 1 if ( $MSWin32 && $MSVC );
201 my @entries = readdir $IN;
203 my $entries = join( ' ', @entries ) . "\n";
204 pir_output_is( <<'CODE', $entries, 'Test OS.readdir' );
207 $P2 = $P1.readdir('.')
218 open my $FILE, ">", "____some_test_file";
220 pir_output_is( <<'CODE', <<"OUT", 'Test OS.rename' );
223 $P1.rename('____some_test_file', '___some_other_file')
224 $I0 = stat '___some_other_file', 0
227 $P1.rm('___some_other_file')
239 skip 'lstat not available on Win 32 yet', 1 if $MSWin32;
244 my @s = stat('xpto');
245 $stat = join( "\n", $s[0], @s[ 2 .. 12 ] ) . "\n";
246 pir_output_is( <<'CODE', $stat, "Test OS.lstat" );
250 $P2 = $P1."lstat"($S1)
259 if $I1 == 13 goto done
271 $lstat = join( "\n", lstat("xpto") ) . "\n";
272 pir_output_is( <<'CODE', $lstat, "Test OS.lstat" );
276 $P2 = $P1."lstat"($S1)
284 if $I1 == 13 goto done
293 # Test remove on a file
294 pir_output_is( <<'CODE', <<"OUT", "Test rm call in a file" );
309 ok( !-f $xpto, "Test that rm removed file" );
310 rmdir $xpto if -f $xpto; # this way next test doesn't fail if this one does
314 skip "Symlinks not available under Windows", 2 if $MSWin32;
316 pir_output_is( <<'CODE', <<"OUT", "Test symlink" );
322 $P1."symlink"($S2, $S1)
332 ok( -l "xpto", "symlink was really created" );
333 unlink "xpto" if -f "xpto";
338 skip "Parrot link not implemented for Windows, yet", 2 if $MSWin32;
340 pir_output_is( <<'CODE', <<"OUT", "Test link" );
356 my $nl = [ stat("MANIFEST") ]->[3];
357 ok( $nl > 1, "hard link was really created" );
358 unlink "xpto" if -f "xpto";
363 # cperl-indent-level: 4
366 # vim: expandtab shiftwidth=4: