1 ##!/usr/local/bin/perl -w
8 plan skip_all => "these tests need Perl 5.5" if $] < 5.005 ;
12 use File::Slurp qw( :all prepend_file edit_file ) ;
14 my $is_win32 = $^O =~ /cygwin|win32/i ;
16 my $file_name = 'test_file' ;
17 my $dir_name = 'test_dir' ;
21 name => 'read_file open error',
23 args => [ $file_name ],
27 name => 'write_file open error',
29 args => [ $file_name, '' ],
30 override => 'sysopen',
34 name => 'write_file syswrite error',
36 args => [ $file_name, '' ],
37 override => 'syswrite',
38 posttest => sub { unlink( $file_name ) },
42 name => 'read_file small sysread error',
44 args => [ $file_name ],
45 override => 'sysread',
46 pretest => sub { write_file( $file_name, '' ) },
47 posttest => sub { unlink( $file_name ) },
51 name => 'read_file loop sysread error',
53 args => [ $file_name ],
54 override => 'sysread',
55 pretest => sub { write_file( $file_name, 'x' x 100_000 ) },
56 posttest => sub { unlink( $file_name ) },
60 name => 'atomic rename error',
61 # this test is meaningless on Win32
64 args => [ $file_name, { atomic => 1 }, '' ],
66 posttest => sub { "$file_name.$$" },
70 name => 'read_dir opendir error',
72 args => [ $dir_name ],
76 name => 'prepend_file read error',
77 sub => \&prepend_file,
78 args => [ $file_name ],
79 error => qr/read_file/,
82 name => 'prepend_file write error',
83 sub => \&prepend_file,
84 pretest => sub { write_file( $file_name, '' ) },
85 args => [ $file_name, '' ],
86 override => 'syswrite',
87 error => qr/write_file/,
88 posttest => sub { unlink $file_name, "$file_name.$$" },
91 name => 'edit_file read error',
93 args => [ sub{}, $file_name ],
94 error => qr/read_file/,
97 name => 'edit_file write error',
99 pretest => sub { write_file( $file_name, '' ) },
100 args => [ sub{}, $file_name ],
101 override => 'syswrite',
102 error => qr/write_file/,
103 posttest => sub { unlink $file_name, "$file_name.$$" },
106 name => 'edit_file_lines read error',
107 sub => \&edit_file_lines,
108 args => [ sub{}, $file_name ],
109 error => qr/read_file/,
112 name => 'edit_file_lines write error',
113 sub => \&edit_file_lines,
114 pretest => sub { write_file( $file_name, '' ) },
115 args => [ sub{}, $file_name ],
116 override => 'syswrite',
117 error => qr/write_file/,
118 posttest => sub { unlink $file_name, "$file_name.$$" },
122 test_driver( $tests ) ;