diff options
Diffstat (limited to 't')
| -rw-r--r-- | t/TestDriver.pm | 91 | ||||
| -rw-r--r-- | t/append_null.t | 24 | ||||
| -rw-r--r-- | t/binmode.t | 50 | ||||
| -rw-r--r-- | t/chomp.t | 53 | ||||
| -rw-r--r-- | t/data_list.t | 62 | ||||
| -rw-r--r-- | t/data_scalar.t | 62 | ||||
| -rw-r--r-- | t/edit_file.t | 107 | ||||
| -rw-r--r-- | t/error.t | 125 | ||||
| -rw-r--r-- | t/error_mode.t | 59 | ||||
| -rw-r--r-- | t/file_object.t | 75 | ||||
| -rw-r--r-- | t/handle.t | 222 | ||||
| -rw-r--r-- | t/inode.t | 44 | ||||
| -rw-r--r-- | t/large.t | 175 | ||||
| -rw-r--r-- | t/newline.t | 52 | ||||
| -rw-r--r-- | t/no_clobber.t | 26 | ||||
| -rw-r--r-- | t/original.t | 55 | ||||
| -rw-r--r-- | t/paragraph.t | 64 | ||||
| -rw-r--r-- | t/perms.t | 31 | ||||
| -rw-r--r-- | t/pod.t | 13 | ||||
| -rw-r--r-- | t/pod_coverage.t | 24 | ||||
| -rw-r--r-- | t/prepend_file.t | 74 | ||||
| -rw-r--r-- | t/pseudo.t | 34 | ||||
| -rw-r--r-- | t/read_dir.t | 66 | ||||
| -rw-r--r-- | t/signal.t | 34 | ||||
| -rw-r--r-- | t/slurp.t | 19 | ||||
| -rw-r--r-- | t/stdin.t | 23 | ||||
| -rw-r--r-- | t/stringify.t | 45 | ||||
| -rw-r--r-- | t/tainted.t | 69 | ||||
| -rw-r--r-- | t/write_file_win32.t | 29 |
29 files changed, 1807 insertions, 0 deletions
diff --git a/t/TestDriver.pm b/t/TestDriver.pm new file mode 100644 index 0000000..274e5d3 --- /dev/null +++ b/t/TestDriver.pm @@ -0,0 +1,91 @@ +# driver.pm - common test driver code + +use Test::More ; + +BEGIN { + *CORE::GLOBAL::syswrite = + sub($$$;$) { my( $h, $b, $s, $o ) = @_; CORE::syswrite $h, $b, $s, $o} ; +# sub(*\$$;$) { my( $h, $b, $s, $o ) = @_; CORE::syswrite $h, $b, $s, $o } ; + + *CORE::GLOBAL::sysread = + sub($$$;$) { my( $h, $b, $s, $o ) = @_; CORE::sysread $h, $b, $s, $o } ; +# sub(*\$$;$) { my( $h, $b, $s, $o ) = @_; CORE::sysread $h, $b, $s, $o } ; + + *CORE::GLOBAL::rename = + sub($$) { my( $old, $new ) = @_; CORE::rename $old, $new } ; + + *CORE::GLOBAL::sysopen = + sub($$$;$) { my( $h, $n, $m, $p ) = @_; CORE::sysopen $h, $n, $m, $p } ; +# sub(*$$;$) { my( $h, $n, $m, $p ) = @_; CORE::sysopen $h, $n, $m, $p } ; +} + +sub test_driver { + + my( $tests ) = @_ ; + +use Data::Dumper ; + +# plan for one expected ok() call per test + + plan( tests => scalar @{$tests} ) ; + +# loop over all the tests + + foreach my $test ( @{$tests} ) { + +#print Dumper $test ; + + if ( $test->{skip} ) { + ok( 1, "SKIPPING $test->{name}" ) ; + next ; + } + + my $override = $test->{override} ; + +# run any setup sub before this test. this can is used to modify the +# object for this test or create test files and data. + + if( my $pretest = $test->{pretest} ) { + + $pretest->($test) ; + } + + if( my $sub = $test->{sub} ) { + + my $args = $test->{args} ; + + local( $^W ) ; + local *{"CORE::GLOBAL::$override"} = sub {} + if $override ; + + $test->{result} = eval { $sub->( @{$args} ) } ; + + if ( $@ ) { + +# if we had an error and expected it, we pass this test + + if ( $test->{error} && + $@ =~ /$test->{error}/ ) { + + $test->{ok} = 1 ; + } + else { + print "unexpected error: $@\n" ; + $test->{ok} = 0 ; + } + } + } + + if( my $posttest = $test->{posttest} ) { + + $posttest->($test) ; + } + + ok( $test->{ok}, $test->{name} ) if exists $test->{ok} ; + is( $test->{result}, $test->{expected}, $test->{name} ) if + exists $test->{expected} ; + + } +} + +1 ; diff --git a/t/append_null.t b/t/append_null.t new file mode 100644 index 0000000..3c8b924 --- /dev/null +++ b/t/append_null.t @@ -0,0 +1,24 @@ +#!/usr/local/bin/perl -w + +use strict ; +use File::Slurp ; + +use Test::More tests => 1 ; + +my $data = <<TEXT ; +line 1 +more text +TEXT + +my $file = 'xxx' ; + +unlink $file ; + +my $err = write_file( $file, $data ) ; +append_file( $file, '' ) ; + +my $read_data = read_file( $file ) ; + +is( $data, $read_data ) ; + +unlink $file ; diff --git a/t/binmode.t b/t/binmode.t new file mode 100644 index 0000000..03534b8 --- /dev/null +++ b/t/binmode.t @@ -0,0 +1,50 @@ +#!/usr/local/bin/perl -w + +use strict ; +use Test::More ; +use Carp ; +use File::Slurp ; + +BEGIN { + plan skip_all => 'Older Perl lacking unicode support' + if $] < 5.008001 ; +} + +plan tests => 2 ; + +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.$suf" ; +my $slurp_file = "slurp.$suf" ; + +open( my $fh, ">$mode", $control_file ) or + die "cannot create control unicode file '$control_file' $!" ; +print $fh $orig_text ; +close $fh ; + +my $slurp_utf = read_file( $control_file, binmode => $mode ) ; +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 $slurp_text_length = length $slurp_text ; +# print "LEN UTF $slurp_utf_length TXT $slurp_text_length\n" ; + +write_file( $slurp_file, {binmode => $mode}, $orig_text ) ; + +open( $fh, "<$mode", $slurp_file ) or + die "cannot open slurp test file '$slurp_file' $!" ; +my $read_length = read( $fh, my $utf_text, $unicode_length ) ; +close $fh ; + +is( $utf_text, $orig_text, "write_file of $mode file" ) ; + +unlink( $control_file, $slurp_file ) ; diff --git a/t/chomp.t b/t/chomp.t new file mode 100644 index 0000000..e14319b --- /dev/null +++ b/t/chomp.t @@ -0,0 +1,53 @@ + +use strict ; +use warnings ; + +use lib qw(t) ; + +use File::Slurp qw( read_file write_file ) ; +use Test::More ; + +use TestDriver ; + +my $file = 'edit_file_data' ; + +my $existing_data = <<PRE ; +line 1 +line 2 +more +foo +bar +junk here and foo +last line +PRE + +my $tests = [ + { + name => 'read_file - chomp', + sub => \&read_file, + args => [ + $file, + { + 'chomp' => 1, + array_ref => 1 + }, + ], + pretest => sub { + my( $test ) = @_ ; + write_file( $file, $existing_data ) ; + }, + posttest => sub { + my( $test ) = @_ ; + $test->{ok} = eq_array( + $test->{result}, + [$existing_data =~ /^(.+)\n/gm] + ) ; + }, + }, +] ; + +test_driver( $tests ) ; + +unlink $file ; + +exit ; diff --git a/t/data_list.t b/t/data_list.t new file mode 100644 index 0000000..ac85b2e --- /dev/null +++ b/t/data_list.t @@ -0,0 +1,62 @@ +#!/usr/local/bin/perl -w + +use strict ; +use File::Slurp ; + +use Carp ; +use POSIX qw( :fcntl_h ) ; +use Test::More tests => 1 ; + +# in case SEEK_SET isn't defined in older perls. it seems to always be 0 + +BEGIN { + + *SEEK_SET = sub { 0 } unless defined \&SEEK_SET ; +} + +SKIP: { + + eval { require B } ; + + skip <<TEXT, 1 if $@ ; +B.pm not found in this Perl. This will cause slurping of +the DATA handle to fail. +TEXT + + test_data_list_slurp() ; +} + +exit ; + + +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 +# golden data sets + + seek( \*DATA, $data_seek, SEEK_SET ) || die "seek $!" ; + my @data_lines = <DATA> ; + +# test the array slurp + + ok( eq_array( \@data_lines, \@slurp_lines ), 'list slurp of DATA' ) ; +} + +__DATA__ +line one +second line +more lines +still more + +enough lines + +we can't test long handle slurps from DATA since i would have to type +too much stuff + +so we will stop here diff --git a/t/data_scalar.t b/t/data_scalar.t new file mode 100644 index 0000000..eb24337 --- /dev/null +++ b/t/data_scalar.t @@ -0,0 +1,62 @@ +#!/usr/local/bin/perl -w + +use strict ; +use File::Slurp ; + +use Carp ; +use POSIX qw( :fcntl_h ) ; +use Test::More tests => 1 ; + +# in case SEEK_SET isn't defined in older perls. it seems to always be 0 + +BEGIN { + + *SEEK_SET = sub { 0 } unless defined \&SEEK_SET ; +} + +eval { require B } ; + +SKIP: { + + skip <<TEXT, 1 if $@ ; +B.pm not found in this Perl. Note this will cause slurping of +the DATA handle to fail. +TEXT + + test_data_scalar_slurp() ; +} + +exit ; + + + +exit ; + +sub test_data_scalar_slurp { + + my $data_seek = tell( \*DATA ); + +# first slurp in the text + + my $slurp_text = read_file( \*DATA ) ; + +# now we need to get the golden data + + seek( \*DATA, $data_seek, SEEK_SET ) || die "seek $!" ; + my $data_text = join( '', <DATA> ) ; + + is( $slurp_text, $data_text, 'scalar slurp of DATA' ) ; +} + +__DATA__ +line one +second line +more lines +still more + +enough lines + +we can't test long handle slurps from DATA since i would have to type +too much stuff + +so we will stop here diff --git a/t/edit_file.t b/t/edit_file.t new file mode 100644 index 0000000..240103a --- /dev/null +++ b/t/edit_file.t @@ -0,0 +1,107 @@ + +use strict ; +use warnings ; + +use lib qw(t) ; + +use File::Slurp qw( :edit read_file write_file ) ; +use Test::More ; + +use TestDriver ; + +my $file = 'edit_file_data' ; + +my $existing_data = <<PRE ; +line 1 +line 2 +more +foo +bar +junk here and foo +last line +PRE + +my $tests = [ + { + name => 'edit_file - no-op', + sub => \&edit_file, + pretest => sub { + my( $test ) = @_ ; + write_file( $file, $existing_data ) ; + $test->{args} = [ + sub {}, + $file + ] ; + $test->{expected} = $existing_data ; + }, + posttest => sub { $_[0]->{result} = read_file( $file ) }, + }, + { + + name => 'edit_file - s/foo/bar/', + sub => \&edit_file, + pretest => sub { + my( $test ) = @_ ; + write_file( $file, $existing_data ) ; + $test->{args} = [ + sub { s/foo/bar/g }, + $file + ] ; + ( $test->{expected} = $existing_data ) + =~ s/foo/bar/g ; + }, + posttest => sub { $_[0]->{result} = read_file( $file ) }, + }, + { + + name => 'edit_file - upper first words', + sub => \&edit_file, + pretest => sub { + my( $test ) = @_ ; + write_file( $file, $existing_data ) ; + $test->{args} = [ + sub { s/^(\w+)/\U$1/gm }, + $file + ] ; + ( $test->{expected} = $existing_data ) + =~ s/^(\w+)/\U$1/gm ; + }, + posttest => sub { $_[0]->{result} = read_file( $file ) }, + }, + { + name => 'edit_file_lines - no-op', + sub => \&edit_file_lines, + pretest => sub { + my( $test ) = @_ ; + write_file( $file, $existing_data ) ; + $test->{args} = [ + sub {}, + $file + ] ; + $test->{expected} = $existing_data ; + }, + posttest => sub { $_[0]->{result} = read_file( $file ) }, + }, + { + + name => 'edit_file - delete foo lines', + sub => \&edit_file_lines, + pretest => sub { + my( $test ) = @_ ; + write_file( $file, $existing_data ) ; + $test->{args} = [ + sub { $_ = '' if /foo/ }, + $file + ] ; + ( $test->{expected} = $existing_data ) + =~ s/^.*foo.*\n//gm ; + }, + posttest => sub { $_[0]->{result} = read_file( $file ) }, + }, +] ; + +test_driver( $tests ) ; + +unlink $file ; + +exit ; diff --git a/t/error.t b/t/error.t new file mode 100644 index 0000000..a241ee5 --- /dev/null +++ b/t/error.t @@ -0,0 +1,125 @@ +##!/usr/local/bin/perl -w + +use lib qw(t) ; +use strict ; +use Test::More ; + +BEGIN { + plan skip_all => "these tests need Perl 5.5" if $] < 5.005 ; +} + +use TestDriver ; +use File::Slurp qw( :all prepend_file edit_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/, + }, + { + name => 'write_file open error', + sub => \&write_file, + 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/, + }, + { + 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/, + }, + { + 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/, + }, + { + name => 'atomic rename error', +# this test is meaningless on Win32 + skip => $is_win32, + sub => \&write_file, + 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/, + }, + { + 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.$$" }, + }, + { + name => 'edit_file read error', + sub => \&edit_file, + args => [ sub{}, $file_name ], + error => qr/read_file/, + }, + { + name => 'edit_file write error', + sub => \&edit_file, + pretest => sub { write_file( $file_name, '' ) }, + args => [ sub{}, $file_name ], + override => 'syswrite', + error => qr/write_file/, + posttest => sub { unlink $file_name, "$file_name.$$" }, + }, + { + name => 'edit_file_lines read error', + sub => \&edit_file_lines, + args => [ sub{}, $file_name ], + error => qr/read_file/, + }, + { + name => 'edit_file_lines write error', + sub => \&edit_file_lines, + pretest => sub { write_file( $file_name, '' ) }, + args => [ sub{}, $file_name ], + override => 'syswrite', + error => qr/write_file/, + posttest => sub { unlink $file_name, "$file_name.$$" }, + }, +] ; + +test_driver( $tests ) ; + +exit ; + diff --git a/t/error_mode.t b/t/error_mode.t new file mode 100644 index 0000000..915c184 --- /dev/null +++ b/t/error_mode.t @@ -0,0 +1,59 @@ +##!/usr/local/bin/perl -w + +use strict ; +use File::Slurp ; + +use Carp ; +use Test::More tests => 9 ; + +my $file = 'missing/file' ; +#unlink $file ; + + +my %modes = ( + 'croak' => \&test_croak, + 'carp' => \&test_carp, + 'quiet' => \&test_quiet, +) ; + +while( my( $mode, $sub ) = each %modes ) { + + $sub->( 'read_file', \&read_file, $file, err_mode => $mode ) ; + $sub->( 'write_file', \&write_file, $file, + { err_mode => $mode }, 'junk' ) ; + $sub->( 'read_dir', \&read_dir, $file, err_mode => $mode ) ; +} + + +sub test_croak { + + my ( $name, $sub, @args ) = @_ ; + + eval { + $sub->( @args ) ; + } ; + + ok( $@, "$name can croak" ) ; +} + +sub test_carp { + + my ( $name, $sub, @args ) = @_ ; + + local $SIG{__WARN__} = sub { ok( 1, "$name can carp" ) } ; + + $sub->( @args ) ; +} + +sub test_quiet { + + my ( $name, $sub, @args ) = @_ ; + + local $SIG{__WARN__} = sub { ok( 0, "$name can be quiet" ) } ; + + eval { + $sub->( @args ) ; + } ; + + ok( !$@, "$name can be quiet" ) ; +} diff --git a/t/file_object.t b/t/file_object.t new file mode 100644 index 0000000..1a6f242 --- /dev/null +++ b/t/file_object.t @@ -0,0 +1,75 @@ +#!perl +use strict; +use Test::More; +use File::Slurp; + +use IO::Handle ; + +use UNIVERSAL ; + +plan tests => 4; + +my $path = "data.txt"; +my $data = "random junk\n"; + +# create an object +my $obj = FileObject->new($path); +isa_ok( $obj, 'FileObject' ); +is( "$obj", $path, "check that the object correctly stringifies" ); + +my $is_glob = eval{ $obj->isa( 'GLOB' ) } ; +#print "GLOB $is_glob\n" ; + +my $is_io = eval{ $obj->isa( 'IO' ) } ; +#print "IO $is_io\n" ; + +my $io = IO::Handle->new() ; +#print "IO2: $io\n" ; + +my $is_io2 = eval{ $io->isa( 'GLOB' ) } ; +#print "IO2 $is_io2\n" ; + +open( FH, "<$0" ) or die "can't open $0: $!" ; + +my $io3 = *FH{IO} ; +#print "IO3: $io3\n" ; + +my $is_io3 = eval{ $io3->isa( 'IO' ) } ; +#print "IO3 $is_io3\n" ; + +my $io4 = *FH{GLOB} ; +#print "IO4: $io4\n" ; + +my $is_io4 = eval{ $io4->isa( 'GLOB' ) } ; +#print "IO4 $is_io4\n" ; + + +SKIP: { + # write something to that file + open(FILE, ">$obj") or skip 4, "can't write to '$path': $!"; + print FILE $data; + close(FILE); + + # pass it to read_file() + my $content = eval { read_file($obj) }; + is( $@, '', "passing an object to read_file()" ); + is( $content, $data, "checking that the content matches the data" ); +} + +unlink $path; + + +# the following mimics the parts from Path::Class causing +# problems with File::Slurp +package FileObject; +use overload + q[""] => \&stringify, fallback => 1; + +sub new { + return bless { path => $_[1] }, $_[0] +} + +sub stringify { + return $_[0]->{path} +} + diff --git a/t/handle.t b/t/handle.t new file mode 100644 index 0000000..4f26847 --- /dev/null +++ b/t/handle.t @@ -0,0 +1,222 @@ +#!/usr/local/bin/perl -w + +use strict ; +use File::Slurp ; + +use Carp ; +use POSIX qw( :fcntl_h ) ; +use Socket ; +use Symbol ; +use Test::More ; + +# in case SEEK_SET isn't defined in older perls. it seems to always be 0 + +BEGIN { + *SEEK_SET = sub() { 0 } unless defined \&SEEK_SET ; +} + +my @pipe_data = ( + '', + 'abc', + 'abc' x 100_000, + 'abc' x 1_000_000, +) ; + +plan( tests => scalar @pipe_data ) ; + +#test_data_slurp() ; + +#test_fork_pipe_slurp() ; + +SKIP: { + + eval { test_socketpair_slurp() } ; + + skip "socketpair not found in this Perl", scalar( @pipe_data ) if $@ ; +} + +sub test_socketpair_slurp { + + foreach my $data ( @pipe_data ) { + + my $size = length( $data ) ; + + my $read_fh = gensym ; + my $write_fh = gensym ; + + socketpair( $read_fh, $write_fh, + AF_UNIX, SOCK_STREAM, PF_UNSPEC); + + if ( fork() ) { + +#warn "PARENT SOCKET\n" ; + close( $write_fh ) ; + my $read_buf = read_file( $read_fh ) ; + + is( $read_buf, $data, + "socket slurp/spew of $size bytes" ) ; + + } + else { + +#child +#warn "CHILD SOCKET\n" ; + close( $read_fh ) ; + eval { write_file( $write_fh, $data ) } ; + exit() ; + } + } +} + +sub test_data_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 +# golden data sets + + seek( \*DATA, $data_seek, SEEK_SET ) || die "seek $!" ; + my @data_lines = <DATA> ; + my $data_text = join( '', @data_lines ) ; + +# now slurp in as one string and test + + sysseek( \*DATA, $data_seek, SEEK_SET ) || die "seek $!" ; + my $slurp_text = read_file( \*DATA ) ; + is( $slurp_text, $data_text, 'scalar slurp DATA' ) ; + +# test the array slurp + + ok( eq_array( \@data_lines, \@slurp_lines ), 'list slurp of DATA' ) ; +} + +sub test_fork_pipe_slurp { + + foreach my $data ( @pipe_data ) { + + test_to_pipe( $data ) ; + test_from_pipe( $data ) ; + } +} + + +sub test_from_pipe { + + my( $data ) = @_ ; + + my $size = length( $data ) ; + + if ( pipe_from_fork( \*READ_FH ) ) { + +# parent + my $read_buf = read_file( \*READ_FH ) ; +warn "PARENT read\n" ; + + is( $read_buf, $data, "pipe slurp/spew of $size bytes" ) ; + + close \*READ_FH ; +# return ; + } + else { +# child +warn "CHILD write\n" ; + # write_file( \*STDOUT, $data ) ; + syswrite( \*STDOUT, $data, length( $data ) ) ; + + close \*STDOUT; + exit(0); + } +} + + +sub pipe_from_fork { + + my ( $parent_fh ) = @_ ; + + my $child = gensym ; + + pipe( $parent_fh, $child ) or die; + + my $pid = fork(); + die "fork() failed: $!" unless defined $pid; + + if ($pid) { + +warn "PARENT\n" ; + close $child; + return $pid ; + } + +warn "CHILD FILENO ", fileno($child), "\n" ; + close $parent_fh ; + open(STDOUT, ">&=" . fileno($child)) or die "no fileno" ; + + return ; +} + + +sub test_to_pipe { + + my( $data ) = @_ ; + + my $size = length( $data ) ; + + if ( pipe_to_fork( \*WRITE_FH ) ) { + +# parent + syswrite( \*WRITE_FH, $data, length( $data ) ) ; +# write_file( \*WRITE_FH, $data ) ; +warn "PARENT write\n" ; + +# is( $read_buf, $data, "pipe slurp/spew of $size bytes" ) ; + + close \*WRITE_FH ; +# return ; + } + else { +# child +warn "CHILD read FILENO ", fileno(\*STDIN), "\n" ; + + my $read_buf = read_file( \*STDIN ) ; + is( $read_buf, $data, "pipe slurp/spew of $size bytes" ) ; + close \*STDIN; + exit(0); + } +} + +sub pipe_to_fork { + my ( $parent_fh ) = @_ ; + + my $child = gensym ; + + pipe( $child, $parent_fh ) or die ; + + my $pid = fork(); + die "fork() failed: $!" unless defined $pid; + + if ( $pid ) { + close $child; + return $pid ; + } + + close $parent_fh ; + open(STDIN, "<&=" . fileno($child)) or die; + + return ; +} + +__DATA__ +line one +second line +more lines +still more + +enough lines + +we don't test long handle slurps from DATA since i would have to type +too much stuff :-) + +so we will stop here diff --git a/t/inode.t b/t/inode.t new file mode 100644 index 0000000..c477baf --- /dev/null +++ b/t/inode.t @@ -0,0 +1,44 @@ +#!/usr/local/bin/perl -w + +use strict ; + +use File::Slurp ; + +use Carp ; +use Socket ; +use Symbol ; +use Test::More ; + +BEGIN { + if( $^O =~ '32' ) { + plan skip_all => 'skip inode test on windows'; + exit ; + } + + plan tests => 2 ; +} + +my $data = <<TEXT ; +line 1 +more text +TEXT + +my $file = 'inode' ; + +write_file( $file, $data ) ; +my $inode_num = (stat $file)[1] ; +write_file( $file, $data ) ; +my $inode_num2 = (stat $file)[1] ; + +#print "I1 $inode_num I2 $inode_num2\n" ; + +ok( $inode_num == $inode_num2, 'same inode' ) ; + +write_file( $file, {atomic => 1}, $data ) ; +$inode_num2 = (stat $file)[1] ; + +#print "I1 $inode_num I2 $inode_num2\n" ; + +ok( $inode_num != $inode_num2, 'different inode' ) ; + +unlink $file ; diff --git a/t/large.t b/t/large.t new file mode 100644 index 0000000..3bd78b7 --- /dev/null +++ b/t/large.t @@ -0,0 +1,175 @@ +#!/usr/local/bin/perl -w + +use strict ; + +use Test::More ; +use Carp ; +use File::Slurp ; + +my $file = 'slurp.data' ; +unlink $file ; + +my @text_data = ( + [], + [ 'a' x 8 ], + [ ("\n") x 5 ], + [ map( "aaaaaaaa\n", 1 .. 3 ) ], + [ map( "aaaaaaaa\n", 1 .. 3 ), 'aaaaaaaa' ], + [ map ( 'a' x 100 . "\n", 1 .. 1024 ) ], + [ map ( 'a' x 100 . "\n", 1 .. 1024 ), 'a' x 100 ], + [ map ( 'a' x 1024 . "\n", 1 .. 1024 ) ], + [ map ( 'a' x 1024 . "\n", 1 .. 1024 ), 'a' x 10240 ], + [], +) ; + +my @bin_sizes = ( 1000, 1024 * 1024 ) ; + +my @bin_stuff = ( "\012", "\015", "\012\015", "\015\012", + map chr, 0 .. 32 ) ; + +my @bin_data ; + +foreach my $size ( @bin_sizes ) { + + my $data = '' ; + + while ( length( $data ) < $size ) { + + $data .= $bin_stuff[ rand @bin_stuff ] ; + } + + push @bin_data, $data ; +} + +plan( tests => 17 * @text_data + 8 * @bin_data ) ; + +#print "# text slurp\n" ; + +foreach my $data ( @text_data ) { + + test_text_slurp( $data ) ; +} + +#print "# BIN slurp\n" ; + +SKIP: { + skip "binmode not available in this version of Perl", 8 * @bin_data + if $] < 5.006 ; + + foreach my $data ( @bin_data ) { + + test_bin_slurp( $data ) ; + } +} + +unlink $file ; + +exit ; + +sub test_text_slurp { + + my( $data_ref ) = @_ ; + + my @data_lines = @{$data_ref} ; + my $data_text = join( '', @data_lines ) ; + + + my $err = write_file( $file, $data_text ) ; + ok( $err, 'write_file - ' . length $data_text ) ; + my $text = read_file( $file ) ; + ok( $text eq $data_text, 'scalar read_file - ' . length $data_text ) ; + + $err = write_file( $file, \$data_text ) ; + ok( $err, 'write_file ref arg - ' . length $data_text ) ; + $text = read_file( $file ) ; + ok( $text eq $data_text, 'scalar read_file - ' . length $data_text ) ; + + $err = write_file( $file, { buf_ref => \$data_text } ) ; + ok( $err, 'write_file buf ref opt - ' . length $data_text ) ; + $text = read_file( $file ) ; + ok( $text eq $data_text, 'scalar read_file - ' . length $data_text ) ; + + my $text_ref = read_file( $file, scalar_ref => 1 ) ; + ok( ${$text_ref} eq $data_text, + 'scalar ref read_file - ' . length $data_text ) ; + + read_file( $file, buf_ref => \my $buffer ) ; + ok( $buffer eq $data_text, + 'buf_ref read_file - ' . length $data_text ) ; + +# my @data_lines = split( m|(?<=$/)|, $data_text ) ; + + $err = write_file( $file, \@data_lines ) ; + ok( $err, 'write_file list ref arg - ' . length $data_text ) ; + $text = read_file( $file ) ; + ok( $text eq $data_text, 'scalar read_file - ' . length $data_text ) ; + +#print map "[$_]\n", @data_lines ; +#print "DATA <@data_lines>\n" ; + + my @array = read_file( $file ) ; + +#print map "{$_}\n", @array ; +#print "ARRAY <@array>\n" ; + + ok( eq_array( \@array, \@data_lines ), + 'array read_file - ' . length $data_text ) ; + + print "READ:\n", map( "[$_]\n", @array ), + "EXP:\n", map( "[$_]\n", @data_lines ) + unless eq_array( \@array, \@data_lines ) ; + + 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 ) ; + + my $text2 = read_file( $file ) ; + ok( $text2 eq $data_text x 2, 'read_file append - ' . length $data_text ) ; + + $err = append_file( $file, $data_text ) ; + ok( $err, 'append_file - ' . length $data_text ) ; + + my $bin3 = read_file( $file ) ; + ok( $bin3 eq $data_text x 3, 'read_file append_file - ' . length $data_text ) ; + + return ; +} + +sub test_bin_slurp { + + my( $data ) = @_ ; + + my $err = write_file( $file, {'binmode' => ':raw'}, $data ) ; + ok( $err, 'write_file bin - ' . length $data ) ; + + my $bin = read_file( $file, 'binmode' => ':raw' ) ; + ok( $bin eq $data, 'scalar read_file bin - ' . length $data ) ; + + my $bin_ref = read_file( $file, scalar_ref => 1, 'binmode' => ':raw' ) ; + ok( ${$bin_ref} eq $data, + 'scalar ref read_file bin - ' . length $data ) ; + + read_file( $file, buf_ref => \(my $buffer), 'binmode' => ':raw' ) ; + ok( $buffer eq $data, 'buf_ref read_file bin - ' . length $data ) ; + + $err = write_file( $file, { append => 1, 'binmode' => ':raw' }, $data ) ; + ok( $err, 'write_file append bin - ' . length $data ) ; + + my $bin2 = read_file( $file, 'binmode' => ':raw' ) ; + ok( $bin2 eq $data x 2, 'read_file append bin - ' . length $data ) ; + + $err = append_file( $file, { 'binmode' => ':raw' }, $data ) ; + ok( $err, 'append_file bin - ' . length $data ) ; + + my $bin3 = read_file( $file, 'binmode' => ':raw' ) ; + ok( $bin3 eq $data x 3, 'read_file bin - ' . length $data ) ; + + return ; +} diff --git a/t/newline.t b/t/newline.t new file mode 100644 index 0000000..70e09d6 --- /dev/null +++ b/t/newline.t @@ -0,0 +1,52 @@ +use Test::More tests => 2 ; + +use strict; +use File::Slurp ; + +my $data = "\r\n\r\n\r\n" ; +my $file_name = 'newline.txt' ; + +stdio_write_file( $file_name, $data ) ; +my $slurped_data = read_file( $file_name ) ; + +my $stdio_slurped_data = stdio_read_file( $file_name ) ; + + +print 'data ', unpack( 'H*', $data), "\n", +'slurp ', unpack('H*', $slurped_data), "\n", +'stdio slurp ', unpack('H*', $stdio_slurped_data), "\n"; + +is( $data, $slurped_data, 'slurp' ) ; + +write_file( $file_name, $data ) ; +$slurped_data = stdio_read_file( $file_name ) ; + +is( $data, $slurped_data, 'spew' ) ; + +unlink $file_name ; + +sub stdio_write_file { + + my( $file_name, $data ) = @_ ; + + local( *FH ) ; + + open( FH, ">$file_name" ) || die "Couldn't create $file_name: $!"; + + print FH $data ; +} + +sub stdio_read_file { + + my( $file_name ) = @_ ; + + open( FH, $file_name ) || die "Couldn't open $file_name: $!"; + + local( $/ ) ; + + my $data = <FH> ; + + return $data ; +} + + diff --git a/t/no_clobber.t b/t/no_clobber.t new file mode 100644 index 0000000..0251a1c --- /dev/null +++ b/t/no_clobber.t @@ -0,0 +1,26 @@ +#!/usr/local/bin/perl -w + +use strict ; +use File::Slurp ; + +use Test::More tests => 2 ; + + +my $data = <<TEXT ; +line 1 +more text +TEXT + +my $file = 'xxx' ; + +unlink $file ; + + +my $err = write_file( $file, { no_clobber => 1 }, $data ) ; +ok( $err, 'new write_file' ) ; + +$err = write_file( $file, { no_clobber => 1, err_mode => 'quiet' }, $data ) ; + +ok( !$err, 'no_clobber write_file' ) ; + +unlink $file ; diff --git a/t/original.t b/t/original.t new file mode 100644 index 0000000..aa2a98f --- /dev/null +++ b/t/original.t @@ -0,0 +1,55 @@ +#!/usr/bin/perl -I. + +# try to honor possible tempdirs +$tmp = "file_$$"; + +$short = <<END; +small +file +END + +$long = <<END; +This is a much longer bit of contents +to store in a file. +END + +print "1..7\n"; + +use File::Slurp; + +&write_file($tmp, $long); +if (&read_file($tmp) eq $long) {print "ok 1\n";} else {print "not ok 1\n";} + +@x = &read_file($tmp); +@y = grep( $_ ne '', split(/(.*?\n)/, $long)); +while (@x && @y) { + last unless $x[0] eq $y[0]; + shift @x; + shift @y; +} +if (@x == @y && (@x ? $x[0] eq $y[0] : 1)) { print "ok 2\n";} else {print "not ok 2\n"} + +&append_file($tmp, $short); +if (&read_file($tmp) eq "$long$short") {print "ok 3\n";} else {print "not ok 3\n";} + +$iold = (stat($tmp))[1]; +&overwrite_file($tmp, $short); +$inew = (stat($tmp))[1]; + +if (&read_file($tmp) eq $short) {print "ok 4\n";} else {print "not ok 4\n";} + +if ($inew == $iold) {print "ok 5\n";} else {print "not ok 5\n";} + +unlink($tmp); + +&overwrite_file($tmp, $long); +if (&read_file($tmp) eq $long) {print "ok 6\n";} else {print "not ok 6\n";} + +unlink($tmp); + +&append_file($tmp, $short); +if (&read_file($tmp) eq $short) {print "ok 7\n";} else {print "not ok 7\n";} + +unlink($tmp); + + diff --git a/t/paragraph.t b/t/paragraph.t new file mode 100644 index 0000000..62cbad7 --- /dev/null +++ b/t/paragraph.t @@ -0,0 +1,64 @@ +#!/usr/local/bin/perl -w + +use strict ; + +use File::Slurp ; +use Test::More ; +use Carp ; + + +my $file = 'slurp.data' ; +unlink $file ; + +my @text_data = ( + [], + [ 'a' x 8 ], + [ "\n" x 5 ], + [ map( "aaaaaaaa\n\n", 1 .. 3 ) ], + [ map( "aaaaaaaa\n\n", 1 .. 3 ), 'aaaaaaaa' ], + [ map( "aaaaaaaa" . ( "\n" x (2 + rand 3) ), 1 .. 100 ) ], + [ map( "aaaaaaaa" . ( "\n" x (2 + rand 3) ), 1 .. 100 ), 'aaaaaaaa' ], + [], +) ; + +plan( tests => 3 * @text_data ) ; + +#print "# text slurp\n" ; + +foreach my $data ( @text_data ) { + + test_text_slurp( $data ) ; +} + + +unlink $file ; + +exit ; + +sub test_text_slurp { + + my( $data_ref ) = @_ ; + + my @data_lines = @{$data_ref} ; + my $data_text = join( '', @data_lines ) ; + + local( $/ ) = '' ; + + my $err = write_file( $file, $data_text ) ; + ok( $err, 'write_file - ' . length $data_text ) ; + + + my @array = read_file( $file ) ; + ok( eq_array( \@array, \@data_lines ), + 'array read_file - ' . length $data_text ) ; + + print "READ:\n", map( "[$_]\n", @array ), + "EXP:\n", map( "[$_]\n", @data_lines ) + unless eq_array( \@array, \@data_lines ) ; + + my $array_ref = read_file( $file, array_ref => 1 ) ; + ok( eq_array( $array_ref, \@data_lines ), + 'array ref read_file - ' . length $data_text ) ; + + return ; +} diff --git a/t/perms.t b/t/perms.t new file mode 100644 index 0000000..4cd01fa --- /dev/null +++ b/t/perms.t @@ -0,0 +1,31 @@ +#!/usr/local/bin/perl -w + +use strict ; +use Test::More ; +use File::Slurp ; + +plan skip_all => "meaningless on Win32" if $^O =~ /win32/i ; +plan tests => 2 ; + +my $file = "perms.$$" ; + +my $text = <<END ; +This is a bit of contents +to store in a file. +END + +umask 027 ; + +write_file( $file, $text ) ; +is( getmode( $file ), 0640, 'default perms works' ) ; +unlink $file ; + +write_file( $file, { perms => 0777 }, $text ) ; +is( getmode( $file ), 0750, 'set perms works' ) ; +unlink $file ; + +exit ; + +sub getmode { + return 07777 & (stat $_[0])[2] ; +} @@ -0,0 +1,13 @@ +#!/usr/local/bin/perl + +use Test::More; + +eval 'use Test::Pod 1.14' ; +plan skip_all => + 'Test::Pod 1.14 required for testing POD' if $@ ; + +all_pod_files_ok( +# { +# trustme => [ qr/slurp/ ] +# } +) ; diff --git a/t/pod_coverage.t b/t/pod_coverage.t new file mode 100644 index 0000000..0026d96 --- /dev/null +++ b/t/pod_coverage.t @@ -0,0 +1,24 @@ +#!/usr/local/bin/perl + +use Test::More; + +eval 'use Test::Pod::Coverage 1.04' ; +plan skip_all => + 'Test::Pod::Coverage 1.04 required for testing POD coverage' if $@ ; + +all_pod_coverage_ok( + { + trustme => [ + 'slurp', + 'O_APPEND', + 'O_BINARY', + 'O_CREAT', + 'O_EXCL', + 'O_RDONLY', + 'O_WRONLY', + 'SEEK_CUR', + 'SEEK_END', + 'SEEK_SET', + ], + } +) ; diff --git a/t/prepend_file.t b/t/prepend_file.t new file mode 100644 index 0000000..ec3c8bb --- /dev/null +++ b/t/prepend_file.t @@ -0,0 +1,74 @@ + +use strict ; +use warnings ; + +use lib qw(t) ; + +use File::Slurp qw( read_file write_file prepend_file ) ; +use Test::More ; + +use TestDriver ; + +my $file = 'prepend_file' ; +my $existing_data = <<PRE ; +line 1 +line 2 +more +PRE + +my $tests = [ + { + name => 'prepend null', + sub => \&prepend_file, + prepend_data => '', + pretest => sub { + my( $test ) = @_ ; + write_file( $file, $existing_data ) ; + my $prepend_data = $test->{prepend_data} ; + $test->{args} = [ + $file, + $prepend_data, + ] ; + $test->{expected} = "$prepend_data$existing_data" ; + }, + posttest => sub { $_[0]->{result} = read_file( $file ) }, + }, + { + name => 'prepend line', + sub => \&prepend_file, + prepend_data => "line 0\n", + pretest => sub { + my( $test ) = @_ ; + write_file( $file, $existing_data ) ; + my $prepend_data = $test->{prepend_data} ; + $test->{args} = [ + $file, + $prepend_data, + ] ; + $test->{expected} = "$prepend_data$existing_data" ; + }, + posttest => sub { $_[0]->{result} = read_file( $file ) }, + }, + { + name => 'prepend partial line', + sub => \&prepend_file, + prepend_data => 'partial line', + pretest => sub { + my( $test ) = @_ ; + write_file( $file, $existing_data ) ; + my $prepend_data = $test->{prepend_data} ; + $test->{args} = [ + $file, + $prepend_data, + ] ; + $test->{expected} = "$prepend_data$existing_data" ; + }, + posttest => sub { $_[0]->{result} = read_file( $file ) }, + }, +] ; + +test_driver( $tests ) ; + +unlink $file ; + +exit ; diff --git a/t/pseudo.t b/t/pseudo.t new file mode 100644 index 0000000..5deda84 --- /dev/null +++ b/t/pseudo.t @@ -0,0 +1,34 @@ +#!/usr/local/bin/perl -w + +use strict ; + +use File::Slurp ; +use Carp ; +use Test::More ; + +plan( tests => 1 ) ; + +my $proc_file = "/proc/$$/auxv" ; + +SKIP: { + + unless ( -r $proc_file ) { + + skip "can't find pseudo file $proc_file", 1 ; + } + + test_pseudo_file() ; +} + +sub test_pseudo_file { + + my $data_do = do{ local( @ARGV, $/ ) = $proc_file; <> } ; + +#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" ; + + is( $data_do, $data_slurp, 'pseudo' ) ; +} diff --git a/t/read_dir.t b/t/read_dir.t new file mode 100644 index 0000000..d04351f --- /dev/null +++ b/t/read_dir.t @@ -0,0 +1,66 @@ +#!/usr/bin/perl -w -I. + +use strict ; +use Test::More tests => 9 ; + +use File::Slurp ; + +# try to honor possible tempdirs + +my $test_dir = "read_dir_$$" ; + +mkdir( $test_dir, 0700) || die "mkdir $test_dir: $!" ; + +my @dir_entries = read_dir( $test_dir ); + +ok( @dir_entries == 0, 'empty dir' ) ; + +@dir_entries = read_dir( $test_dir, keep_dot_dot => 1 ) ; + +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 ) ; + +ok( @dir_entries == 1, 'dir with 1 file' ) ; + +ok( $dir_entries[0] eq 'x', 'dir with file x' ) ; + +my $file_cnt = 23 ; + +my @expected_entries = sort( 'x', 1 .. $file_cnt ) ; + +for ( 1 .. $file_cnt ) { + + write_file( "$test_dir/$_", "foo\n" ) ; +} + +@dir_entries = read_dir( $test_dir ) ; +@dir_entries = sort @dir_entries ; + +ok( eq_array( \@dir_entries, \@expected_entries ), + "dir with $file_cnt files" ) ; + +my $dir_entries_ref = read_dir( $test_dir ) ; +@{$dir_entries_ref} = sort @{$dir_entries_ref} ; + +ok( eq_array( $dir_entries_ref, \@expected_entries ), + "dir in array ref" ) ; + +my @prefixed_entries = read_dir( $test_dir, {prefix => 1} ) ; +@prefixed_entries = sort @prefixed_entries ; +ok( eq_array( \@prefixed_entries, [map "$test_dir/$_", @dir_entries] ), + 'prefix option' ) ; + +# clean up + +unlink map "$test_dir/$_", @dir_entries ; +rmdir( $test_dir ) || die "rmdir $test_dir: $!"; +ok( 1, 'cleanup' ) ; + +__END__ diff --git a/t/signal.t b/t/signal.t new file mode 100644 index 0000000..2c692d0 --- /dev/null +++ b/t/signal.t @@ -0,0 +1,34 @@ +#!/usr/local/bin/perl -w + +use strict ; +use File::Slurp qw(read_file); + +use Carp ; +use Test::More ; + +BEGIN { + if( $^O =~ '32' ) { + plan skip_all => 'skip signal test on windows'; + exit ; + } + + plan tests => 1 ; +} + +$SIG{CHLD} = sub {}; + +pipe(IN, OUT); + +print "forking\n"; +if (!fork) { + sleep 1; + exit; +} +if (!fork) { + sleep 2; + print OUT "success"; + exit; +} +close OUT; +my $data = read_file(\*IN); +is ($data, "success", "handle EINTR failed"); diff --git a/t/slurp.t b/t/slurp.t new file mode 100644 index 0000000..3ba53e3 --- /dev/null +++ b/t/slurp.t @@ -0,0 +1,19 @@ +#!/usr/local/bin/perl -w -T + +use strict ; +use File::Slurp qw( write_file slurp ) ; + +use Test::More tests => 1 ; + +my $data = <<TEXT ; +line 1 +more text +TEXT + +my $file = 'xxx' ; + +write_file( $file, $data ) ; +my $read_buf = slurp( $file ) ; +is( $read_buf, $data, 'slurp alias' ) ; + +unlink $file ; diff --git a/t/stdin.t b/t/stdin.t new file mode 100644 index 0000000..071e0d3 --- /dev/null +++ b/t/stdin.t @@ -0,0 +1,23 @@ +#!/usr/local/bin/perl -w + +use strict ; +use File::Slurp ; + +use Carp ; +use Socket ; +use Symbol ; +use Test::More tests => 6 ; + +my $data = <<TEXT ; +line 1 +more text +TEXT + +foreach my $file ( qw( stdin STDIN stdout STDOUT stderr STDERR ) ) { + + write_file( $file, $data ) ; + my $read_buf = read_file( $file ) ; + is( $read_buf, $data, 'read/write of file [$file]' ) ; + + unlink $file ; +} diff --git a/t/stringify.t b/t/stringify.t new file mode 100644 index 0000000..c3809cb --- /dev/null +++ b/t/stringify.t @@ -0,0 +1,45 @@ +#!perl -T + +use strict; + +use Test::More; +use File::Slurp; +use IO::Handle ; +use UNIVERSAL ; + +plan tests => 3 ; + +my $path = "data.txt"; +my $data = "random junk\n"; + +# create an object with an overloaded path + +my $obj = FileObject->new( $path ) ; + +isa_ok( $obj, 'FileObject' ) ; +is( "$obj", $path, "object stringifies to path" ); + +write_file( $obj, $data ) ; + +my $read_text = read_file( $obj ) ; +is( $data, $read_text, 'read_file of stringified object' ) ; + +unlink $path ; + +exit ; + +# this code creates the object which has a stringified path + +package FileObject; + +use overload + q[""] => \&stringify, + fallback => 1 ; + +sub new { + return bless { path => $_[1] }, $_[0] +} + +sub stringify { + return $_[0]->{path} +} diff --git a/t/tainted.t b/t/tainted.t new file mode 100644 index 0000000..6805d48 --- /dev/null +++ b/t/tainted.t @@ -0,0 +1,69 @@ +#!perl -T + +use strict; +use Test::More; +use File::Slurp; + +plan 'skip_all', "Scalar::Util not available" unless + eval 'use Scalar::Util qw(tainted) ; tainted($0) ; 1'; + +plan 'tests', 5; + +my $path = "data.txt"; +my $data = "random junk\nline2"; + +SKIP: { + # write something to that file + open(FILE, ">$path") or skip 4, "can't write to '$path': $!"; + print FILE $data; + close(FILE); + + # read the file using File::Slurp in scalar context + my $content = eval { read_file($path) }; + is( $@, '', "read_file() in scalar context" ); + ok( tainted($content), " => returned content should be tainted" ); + + +# # reconstruct the full lines by merging items by pairs +# for my $k (0..int($#lines/2)) { +# my $i = $k * 2; +# $lines[$k] = (defined $lines[$i] ? $lines[$i] : '') +# . (defined $lines[$i+1] ? $lines[$i+1] : ''); +# } + +# # remove the rest of the items +# splice(@lines, int($#lines/2)+1); +# pop @lines unless $lines[-1]; + +# $_ .= $/ for @lines ; + +# my @lines = split m{$/}, $content, -1; +# my @parts = split m{($/)}, $content, -1; + +# # my @parts = $content =~ m{.+?(?:$/)?}g ; + +# my @lines ; +# while( @parts > 2 ) { + +# my( $line, $sep ) = splice( @parts, 0, 2 ) ; +# push @lines, "$line$sep" ; +# } + +# push @lines, shift @parts if @parts ; + +# # ok( tainted($lines[0]), " text => returned content should be tainted" ); + + # read the file using File::Slurp in list context + my @content = eval { read_file($path) }; + is( $@, '', "read_file() in list context" ); + ok( tainted($content[0]), " => returned content should be tainted" ); + + my $text = join( '', @content ) ; + + is( $text, $content, "list eq scalar" ); + + +# ok( tainted($lines[0]), " => returned content should be tainted" ); +} + +unlink $path; diff --git a/t/write_file_win32.t b/t/write_file_win32.t new file mode 100644 index 0000000..1e42456 --- /dev/null +++ b/t/write_file_win32.t @@ -0,0 +1,29 @@ +use strict; +use File::Slurp ; + +use Test::More tests => 1; + +BEGIN { $^W = 1 } + +sub simple_write_file { + open FH, ">$_[0]" or die "Couldn't open $_[0] for write: $!"; + print FH $_[1]; + close FH ; +} + +sub newline_size { + my ($code) = @_; + + my $file = __FILE__ . '.tmp'; + + local $\ = ''; + $code->($file, "\n" x 3); + + my $size = -s $file; + + unlink $file; + + return $size; +} + +is(newline_size(\&write_file), newline_size(\&simple_write_file), 'newline'); |