Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: 97aa16a4d8
Fetching contributors…

Cannot retrieve contributors at this time

336 lines (254 sloc) 5.743 kB
#! perl
# Copyright (C) 2001-2006, Parrot Foundation.
use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
use Parrot::Test tests => 9;
use Parrot::Config;
use Cwd;
use File::Temp;
use File::Spec::Functions;
my $tempdir = File::Temp::tempdir( CLEANUP => 1 );
our ( $MSWin32, $cygwin );
$MSWin32 = 1 if $^O =~ m!MSWin32!;
$cygwin = 1 if $^O =~ m!cygwin!;
=head1 NAME
t/pmc/file.t - Files functions
=head1 SYNOPSIS
% prove t/dynpmc/file.t
=head1 DESCRIPTION
Tests the C<File> PMC.
=cut
my $xpto = catdir( $tempdir, 'xpto' );
mkdir $xpto unless -d $xpto;
my $otpx = catfile( $xpto, 'otpx' );
open my $fh, '>', $otpx or die $!;
print $fh 'xpto';
close $fh;
# test is_dir
pir_output_is( <<"CODE", <<"OUT", "Test is_dir" );
.sub main :main
\$P0 = loadlib 'file'
\$P1 = new ['File']
\$S1 = '$xpto'
\$I1 = \$P1."is_dir"(\$S1)
if \$I1 goto ok1
print "not "
ok1:
print "ok 1\\n"
\$S1 = '$otpx'
\$I1 = \$P1."is_dir"(\$S1)
\$I1 = !\$I1
if \$I1 goto ok2
print "not "
ok2:
print "ok 2\\n"
end
.end
CODE
ok 1
ok 2
OUT
# test is_dir
pir_error_output_like( <<"CODE", <<"OUT", "Test is_dir error" );
.sub main :main
\$P0 = loadlib 'file'
\$P1 = new ['File']
#make a filename that's long enough to cause lstat to fail
\$I0 = 1000
loop:
\$S0 = concat \$S0, "1234567890"
\$I0 = \$I0 - 1
if \$I0 goto loop
\$I1 = \$P1."is_dir"(\$S0)
end
.end
CODE
/stat failed/
OUT
# test is_file
pir_output_is( <<"CODE", <<"OUT", "Test is_file" );
.sub main :main
\$P0 = loadlib 'file'
\$P1 = new ['File']
\$S1 = '$xpto'
\$I1 = \$P1."is_file"(\$S1)
\$I1 = !\$I1
if \$I1 goto ok1
print "not "
ok1:
print "ok 1\\n"
\$S1 = '$otpx'
\$I1 = \$P1."is_file"(\$S1)
if \$I1 goto ok2
print "not "
ok2:
print "ok 2\\n"
end
.end
CODE
ok 1
ok 2
OUT
# test is_file
pir_error_output_like( <<"CODE", <<"OUT", "Test is_file error" );
.sub main :main
\$P0 = loadlib 'file'
\$P1 = new ['File']
#make a filename that's long enough to cause lstat to fail
\$I0 = 1000
loop:
\$S0 = concat \$S0, "1234567890"
\$I0 = \$I0 - 1
if \$I0 goto loop
\$I1 = \$P1."is_file"(\$S0)
end
.end
CODE
/stat failed/
OUT
SKIP: {
skip "Links not available under Windows", 1 if $MSWin32;
my $lotpx = catfile( $xpto, 'lotpx' );
symlink $otpx, $lotpx;
# test is_link
pir_output_is( <<"CODE", <<"OUT", "Test is_link with links to files" );
.sub main :main
\$P0 = loadlib 'file'
\$P1 = new ['File']
\$S1 = '$lotpx'
\$I1 = \$P1."is_link"(\$S1)
if \$I1 goto ok1
print "not "
ok1:
print "ok 1\\n"
\$S1 = '$otpx'
\$I1 = \$P1."is_link"(\$S1)
\$I1 = !\$I1
if \$I1 goto ok2
print "not "
ok2:
print "ok 2\\n"
end
.end
CODE
ok 1
ok 2
OUT
}
SKIP: {
skip "Links not available under Windows", 1 if $MSWin32;
my $xptol = catdir( $xpto, 'xptol' );
symlink $xpto, $xptol;
# test is_link
pir_output_is( <<"CODE", <<"OUT", "Test is_link with links to directories" );
.sub main :main
\$P0 = loadlib 'file'
\$P1 = new ['File']
\$S1 = '$xptol'
\$I1 = \$P1."is_link"(\$S1)
if \$I1 goto ok1
print "not "
ok1:
print "ok 1\\n"
\$S1 = '$xpto'
\$I1 = \$P1."is_link"(\$S1)
\$I1 = !\$I1
if \$I1 goto ok2
print "not "
ok2:
print "ok 2\\n"
end
.end
CODE
ok 1
ok 2
OUT
}
my $otpxcopy = catdir( $xpto, 'otpxcopy' );
# test copy
pir_output_is( <<"CODE", <<"OUT", "Test copy for files" );
.sub main :main
\$S1 = '$otpx'
\$S2 = '$otpxcopy'
\$P0 = loadlib 'file'
\$P1 = new ['File']
\$P2 = new ['OS']
\$P1."copy"(\$S1,\$S2)
print "ok\\n"
\$P3 = \$P2."stat"(\$S1)
\$P4 = \$P2."stat"(\$S2)
\$I1 = \$P3[7]
\$I2 = \$P4[7]
if \$I1 == \$I2 goto ok
print "not "
ok:
print "ok\\n"
end
.end
CODE
ok
ok
OUT
# test rename
SKIP: {
skip 'file exists', 1 if $MSWin32;
pir_output_is( <<"CODE", <<"OUT", "Test rename for files" );
.sub main :main
\$S1 = '$otpx'
\$S2 = '$otpxcopy'
\$P0 = loadlib 'file'
\$P1 = new ['File']
\$P2 = new ['OS']
\$P3 = \$P2."stat"(\$S1)
\$I1 = \$P3[7]
\$P1."rename"(\$S1,\$S2)
print "ok\\n"
\$P4 = \$P2."stat"(\$S2)
\$I2 = \$P4[7]
if \$I1 == \$I2 goto ok
print "not "
ok:
print "ok\\n"
end
.end
CODE
ok
ok
OUT
}
my $bad_file = catfile( $xpto, 'not a file' );
# test exists
pir_output_is( <<"CODE", <<"OUT", "Test rename for files" );
.sub main :main
\$P0 = loadlib 'file'
\$P1 = new ['File']
\$I1 = \$P1.'exists'( '$otpxcopy' )
if \$I1 goto file_exists
print "not "
file_exists:
print "ok 1 - file exists\\n"
\$I1 = \$P1.'exists'( '$xpto' )
if \$I1 goto dir_exists
print "not "
dir_exists:
print "ok 2 - directory exists\\n"
\$I1 = \$P1.'exists'( '$bad_file' )
if \$I1 == 0 goto file_does_not_exist
print "not "
file_does_not_exist:
print "ok 3 - file does not exist\\n"
end
.end
CODE
ok 1 - file exists
ok 2 - directory exists
ok 3 - file does not exist
OUT
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
Jump to Line
Something went wrong with that request. Please try again.