From: Uri Guttman <uri@quad.(none)>
Date: Sat, 16 Apr 2011 08:05:23 +0000 (-0400)
Subject: changes
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=12444d55c2adf5750309cf8afdb16f9b247fd227;p=urisagit%2FPerl-Docs.git
changes
---
diff --git a/t/binmode.t b/t/binmode.t
index 5549130..03534b8 100644
--- a/t/binmode.t
+++ b/t/binmode.t
@@ -5,20 +5,24 @@ use Test::More ;
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' $!" ;
@@ -26,7 +30,8 @@ print $fh $orig_text ;
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 ) ;
@@ -40,6 +45,6 @@ open( $fh, "<$mode", $slurp_file ) or
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 ) ;
diff --git a/t/data_list.t b/t/data_list.t
index 1d4464f..ac85b2e 100644
--- a/t/data_list.t
+++ b/t/data_list.t
@@ -34,7 +34,7 @@ sub test_data_list_slurp {
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
diff --git a/t/error.t b/t/error.t
index ff5a6d7..770b252 100644
--- a/t/error.t
+++ b/t/error.t
@@ -2,124 +2,92 @@
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 ) ;
diff --git a/t/handle.t b/t/handle.t
index 5e1cd15..4f26847 100644
--- a/t/handle.t
+++ b/t/handle.t
@@ -46,7 +46,7 @@ sub test_socketpair_slurp {
socketpair( $read_fh, $write_fh,
AF_UNIX, SOCK_STREAM, PF_UNSPEC);
-
+
if ( fork() ) {
#warn "PARENT SOCKET\n" ;
@@ -62,7 +62,7 @@ sub test_socketpair_slurp {
#child
#warn "CHILD SOCKET\n" ;
close( $read_fh ) ;
- write_file( $write_fh, $data ) ;
+ eval { write_file( $write_fh, $data ) } ;
exit() ;
}
}
diff --git a/t/large.t b/t/large.t
index 4772b19..3bd78b7 100644
--- a/t/large.t
+++ b/t/large.t
@@ -41,7 +41,7 @@ foreach my $size ( @bin_sizes ) {
push @bin_data, $data ;
}
-plan( tests => 16 * @text_data + 8 * @bin_data ) ;
+plan( tests => 17 * @text_data + 8 * @bin_data ) ;
#print "# text slurp\n" ;
@@ -52,9 +52,14 @@ foreach my $data ( @text_data ) {
#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 ;
@@ -114,10 +119,14 @@ sub test_text_slurp {
"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 ) ;
diff --git a/t/newline.t b/t/newline.t
old mode 100755
new mode 100644
diff --git a/t/perms.t b/t/perms.t
index 4b779df..4cd01fa 100644
--- a/t/perms.t
+++ b/t/perms.t
@@ -4,6 +4,7 @@ use strict ;
use Test::More ;
use File::Slurp ;
+plan skip_all => "meaningless on Win32" if $^O =~ /win32/i ;
plan tests => 2 ;
my $file = "perms.$$" ;
diff --git a/t/pseudo.t b/t/pseudo.t
index af0c956..5deda84 100644
--- a/t/pseudo.t
+++ b/t/pseudo.t
@@ -24,11 +24,11 @@ sub test_pseudo_file {
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' ) ;
}
diff --git a/t/read_dir.t b/t/read_dir.t
index d0b372c..9cc939c 100644
--- a/t/read_dir.t
+++ b/t/read_dir.t
@@ -1,7 +1,7 @@
#!/usr/bin/perl -w -I.
use strict ;
-use Test::More tests => 7 ;
+use Test::More tests => 8 ;
use File::Slurp ;
@@ -19,6 +19,10 @@ ok( @dir_entries == 0, 'empty dir' ) ;
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 ) ;
diff --git a/t/slurp.t b/t/slurp.t
index 7a28e5b..3ba53e3 100644
--- a/t/slurp.t
+++ b/t/slurp.t
@@ -1,4 +1,4 @@
-#!/usr/local/bin/perl -w
+#!/usr/local/bin/perl -w -T
use strict ;
use File::Slurp qw( write_file slurp ) ;
diff --git a/t/write_file_win32.t b/t/write_file_win32.t
index 2c4023e..1e42456 100644
--- a/t/write_file_win32.t
+++ b/t/write_file_win32.t
@@ -6,8 +6,9 @@ use Test::More tests => 1;
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 {