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 {