From: Uri Guttman 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 {