t/error.t

   1 ##!/usr/local/bin/perl -w
   2
   3 use lib qw(t) ;
   4 use strict ;
   5 use Test::More ;
   6
   7 BEGIN {
   8         plan skip_all => "these tests need Perl 5.5" if $] < 5.005 ;
   9 }
  10
  11 use TestDriver ;
  12 use File::Slurp qw( :all prepend_file edit_file ) ;
  13
  14 my $is_win32 = $^O =~ /cygwin|win32/i ;
  15
  16 my $file_name = 'test_file' ;
  17 my $dir_name = 'test_dir' ;
  18
  19 my $tests = [
  20         {
  21                 name    => 'read_file open error',
  22                 sub     => \&read_file,
  23                 args    => [ $file_name ],
  24                 error   => qr/open/,
  25         },
  26         {
  27                 name    => 'write_file open error',
  28                 sub     => \&write_file,
  29                 args    => [ $file_name, '' ],
  30                 override => 'sysopen',
  31                 error   => qr/open/,
  32         },
  33         {
  34                 name    => 'write_file syswrite error',
  35                 sub     => \&write_file,
  36                 args    => [ $file_name, '' ],
  37                 override => 'syswrite',
  38                 posttest => sub { unlink( $file_name ) },
  39                 error   => qr/write/,
  40         },
  41         {
  42                 name    => 'read_file small sysread error',
  43                 sub     => \&read_file,
  44                 args    => [ $file_name ],
  45                 override => 'sysread',
  46                 pretest => sub { write_file( $file_name, '' ) },
  47                 posttest => sub { unlink( $file_name ) },
  48                 error   => qr/read/,
  49         },
  50         {
  51                 name    => 'read_file loop sysread error',
  52                 sub     => \&read_file,
  53                 args    => [ $file_name ],
  54                 override => 'sysread',
  55                 pretest => sub { write_file( $file_name, 'x' x 100_000 ) },
  56                 posttest => sub { unlink( $file_name ) },
  57                 error   => qr/read/,
  58         },
  59         {
  60                 name    => 'atomic rename error',
  61 # this test is meaningless on Win32
  62                 skip    => $is_win32,
  63                 sub     => \&write_file,
  64                 args    => [ $file_name, { atomic => 1 }, '' ],
  65                 override => 'rename',
  66                 posttest => sub { "$file_name.$$" },
  67                 error   => qr/rename/,
  68         },
  69         {
  70                 name    => 'read_dir opendir error',
  71                 sub     => \&read_dir,
  72                 args    => [ $dir_name ],
  73                 error   => qr/open/,
  74         },
  75         {
  76                 name    => 'prepend_file read error',
  77                 sub     => \&prepend_file,
  78                 args    => [ $file_name ],
  79                 error   => qr/read_file/,
  80         },
  81         {
  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.$$" },
  89         },
  90         {
  91                 name    => 'edit_file read error',
  92                 sub     => \&edit_file,
  93                 args    => [ sub{}, $file_name ],
  94                 error   => qr/read_file/,
  95         },
  96         {
  97                 name    => 'edit_file write error',
  98                 sub     => \&edit_file,
  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.$$" },
 104         },
 105         {
 106                 name    => 'edit_file_lines read error',
 107                 sub     => \&edit_file_lines,
 108                 args    => [ sub{}, $file_name ],
 109                 error   => qr/read_file/,
 110         },
 111         {
 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.$$" },
 119         },
 120 ] ;
 121
 122 test_driver( $tests ) ;
 123
 124 exit ;
 125