use Carp ;
use File::Slurp ;
-if ( $] < 5.008001 ) {
- plan skip_all => 'Older Perl lacking unicode support' ;
- exit ;
+BEGIN {
+ plan skip_all => 'Older Perl lacking unicode support'
+ if $] < 5.008001 ;
}
plan tests => 2 ;
-my $mode = ':utf8' ;
+my $suf = 'utf8' ;
+my $mode = ":$suf" ;
+
+my $is_win32 = $^O =~ /win32/i ;
my $orig_text = "\x{20ac}\n" ;
+( my $win32_text = $orig_text ) =~ s/\n/\015\012/ ;
my $unicode_length = length $orig_text ;
-my $control_file = "control.$mode" ;
-my $slurp_file = "slurp.$mode" ;
+my $control_file = "control.$suf" ;
+my $slurp_file = "slurp.$suf" ;
open( my $fh, ">$mode", $control_file ) or
die "cannot create control unicode file '$control_file' $!" ;
close $fh ;
my $slurp_utf = read_file( $control_file, binmode => $mode ) ;
-ok( $slurp_utf eq $orig_text, "read_file of $mode file" ) ;
+my $written_text = $is_win32 ? $win32_text : $orig_text ;
+is( $slurp_utf, $written_text, "read_file of $mode file" ) ;
# my $slurp_utf_length = length $slurp_utf ;
# my $slurp_text = read_file( $control_file ) ;
my $read_length = read( $fh, my $utf_text, $unicode_length ) ;
close $fh ;
-ok( $utf_text eq $orig_text, "write_file of $mode file" ) ;
+is( $utf_text, $orig_text, "write_file of $mode file" ) ;
unlink( $control_file, $slurp_file ) ;
my $data_seek = tell( \*DATA );
# first slurp in the lines
-
+
my @slurp_lines = read_file( \*DATA ) ;
# now seek back and read all the lines with the <> op and we make
use lib qw(t) ;
use strict ;
-use driver ;
+use Test::More ;
-use File::Slurp qw( :all ) ;
+BEGIN {
+ plan skip_all => "these tests need Perl 5.5" if $] < 5.005 ;
+}
+
+use TestDriver ;
+use File::Slurp qw( :all prepend_file ) ;
+
+my $is_win32 = $^O =~ /cygwin|win32/i ;
my $file_name = 'test_file' ;
my $dir_name = 'test_dir' ;
my $tests = [
-
{
name => 'read_file open error',
sub => \&read_file,
args => [ $file_name ],
-
- error => qr/open/,
-
- skip => 1,
+ error => qr/open/,
},
-
{
name => 'write_file open error',
sub => \&write_file,
- args => [ "$dir_name/$file_name", '' ],
- pretest => sub {
- mkdir $dir_name ;
- chmod( 0555, $dir_name ) ;
- },
-
- posttest => sub {
-
- chmod( 0777, $dir_name ) ;
- rmdir $dir_name ;
- },
-
- error => qr/open/,
- skip => 1,
+ args => [ $file_name, '' ],
+ override => 'sysopen',
+ error => qr/open/,
},
-
{
name => 'write_file syswrite error',
sub => \&write_file,
args => [ $file_name, '' ],
- override => 'syswrite',
-
- posttest => sub {
- unlink( $file_name ) ;
- },
-
-
- error => qr/write/,
- skip => 1,
+ override => 'syswrite',
+ posttest => sub { unlink( $file_name ) },
+ error => qr/write/,
},
-
{
name => 'read_file small sysread error',
sub => \&read_file,
args => [ $file_name ],
- override => 'sysread',
-
- pretest => sub {
- write_file( $file_name, '' ) ;
- },
-
- posttest => sub {
- unlink( $file_name ) ;
- },
-
-
- error => qr/read/,
+ override => 'sysread',
+ pretest => sub { write_file( $file_name, '' ) },
+ posttest => sub { unlink( $file_name ) },
+ error => qr/read/,
},
-
{
name => 'read_file loop sysread error',
sub => \&read_file,
args => [ $file_name ],
- override => 'sysread',
-
- pretest => sub {
- write_file( $file_name, 'x' x 100_000 ) ;
- },
-
- posttest => sub {
- unlink( $file_name ) ;
- },
-
-
- error => qr/read/,
+ override => 'sysread',
+ pretest => sub { write_file( $file_name, 'x' x 100_000 ) },
+ posttest => sub { unlink( $file_name ) },
+ error => qr/read/,
},
-
{
name => 'atomic rename error',
+# this test is meaningless on Win32
+ skip => $is_win32,
sub => \&write_file,
- args => [ "$dir_name/$file_name", { atomic => 1 }, '' ],
- pretest => sub {
- mkdir $dir_name ;
- write_file( "$dir_name/$file_name.$$", '' ) ;
- chmod( 0555, $dir_name ) ;
- },
-
- posttest => sub {
-
- chmod( 0777, $dir_name ) ;
- unlink( "$dir_name/$file_name.$$" ) ;
- rmdir $dir_name ;
- },
-
- error => qr/rename/,
- skip => 1,
+ args => [ $file_name, { atomic => 1 }, '' ],
+ override => 'rename',
+ posttest => sub { "$file_name.$$" },
+ error => qr/rename/,
},
-
{
name => 'read_dir opendir error',
sub => \&read_dir,
args => [ $dir_name ],
-
- error => qr/open/,
- skip => 1,
+ error => qr/open/,
+ },
+ {
+ name => 'prepend_file read error',
+ sub => \&prepend_file,
+ args => [ $file_name ],
+ error => qr/read_file/,
},
+ {
+ name => 'prepend_file write error',
+ sub => \&prepend_file,
+ pretest => sub { write_file( $file_name, '' ) },
+ args => [ $file_name, '' ],
+ override => 'syswrite',
+ error => qr/write_file/,
+ posttest => sub { unlink $file_name, "$file_name.$$" },
+ },
+
] ;
test_driver( $tests ) ;
socketpair( $read_fh, $write_fh,
AF_UNIX, SOCK_STREAM, PF_UNSPEC);
-
+
if ( fork() ) {
#warn "PARENT SOCKET\n" ;
#child
#warn "CHILD SOCKET\n" ;
close( $read_fh ) ;
- write_file( $write_fh, $data ) ;
+ eval { write_file( $write_fh, $data ) } ;
exit() ;
}
}
push @bin_data, $data ;
}
-plan( tests => 16 * @text_data + 8 * @bin_data ) ;
+plan( tests => 17 * @text_data + 8 * @bin_data ) ;
#print "# text slurp\n" ;
#print "# BIN slurp\n" ;
-foreach my $data ( @bin_data ) {
+SKIP: {
+ skip "binmode not available in this version of Perl", 8 * @bin_data
+ if $] < 5.006 ;
- test_bin_slurp( $data ) ;
+ foreach my $data ( @bin_data ) {
+
+ test_bin_slurp( $data ) ;
+ }
}
unlink $file ;
"EXP:\n", map( "[$_]\n", @data_lines )
unless eq_array( \@array, \@data_lines ) ;
- my $array_ref = read_file( $file, array_ref => 1 ) ;
+ my $array_ref = read_file( $file, array_ref => 1 ) ;
ok( eq_array( $array_ref, \@data_lines ),
'array ref read_file - ' . length $data_text ) ;
+ ($array_ref) = read_file( $file, {array_ref => 1} ) ;
+ ok( eq_array( $array_ref, \@data_lines ),
+ 'array ref list context args ref read_file - ' . length $data_text ) ;
+
$err = write_file( $file, { append => 1 }, $data_text ) ;
ok( $err, 'write_file append - ' . length $data_text ) ;
use Test::More ;
use File::Slurp ;
+plan skip_all => "meaningless on Win32" if $^O =~ /win32/i ;
plan tests => 2 ;
my $file = "perms.$$" ;
my $data_do = do{ local( @ARGV, $/ ) = $proc_file; <> } ;
-print "LEN: ", length $data_do, "\n" ;
+#print "LEN: ", length $data_do, "\n" ;
my $data_slurp = read_file( $proc_file ) ;
-print "LEN2: ", length $data_slurp, "\n" ;
-print "LEN3: ", -s $proc_file, "\n" ;
+#print "LEN2: ", length $data_slurp, "\n" ;
+#print "LEN3: ", -s $proc_file, "\n" ;
is( $data_do, $data_slurp, 'pseudo' ) ;
}
#!/usr/bin/perl -w -I.
use strict ;
-use Test::More tests => 7 ;
+use Test::More tests => 8 ;
use File::Slurp ;
ok( @dir_entries == 2, 'empty dir with . ..' ) ;
+@dir_entries = read_dir( $test_dir, { keep_dot_dot => 1 } ) ;
+
+ok( @dir_entries == 2, 'empty dir with . .. - args ref' ) ;
+
write_file( "$test_dir/x", "foo\n" ) ;
@dir_entries = read_dir( $test_dir ) ;
-#!/usr/local/bin/perl -w
+#!/usr/local/bin/perl -w -T
use strict ;
use File::Slurp qw( write_file slurp ) ;
BEGIN { $^W = 1 }
sub simple_write_file {
- open my $fh, '>', $_[0] or die "Couldn't open $_[0] for write: $!";
- print $fh $_[1];
+ open FH, ">$_[0]" or die "Couldn't open $_[0] for write: $!";
+ print FH $_[1];
+ close FH ;
}
sub newline_size {
projects / urisagit/Perl-Docs.git / commitdiff