t/error.t

   1 ##!/usr/local/bin/perl -w
   2
   3 use lib qw(t) ;
   4 use strict ;
   5 use driver ;
   6
   7 use File::Slurp qw( :all ) ;
   8
   9 my $file_name = 'test_file' ;
  10 my $dir_name = 'test_dir' ;
  11
  12 my $tests = [
  13
  14         {
  15                 name    => 'read_file open error',
  16                 sub     => \&read_file,
  17                 args    => [ $file_name ],
  18
  19                 error => qr/open/,
  20
  21                 skip    => 1,
  22         },
  23
  24         {
  25                 name    => 'write_file open error',
  26                 sub     => \&write_file,
  27                 args    => [ "$dir_name/$file_name", '' ],
  28                 pretest => sub {
  29                         mkdir $dir_name ;
  30                         chmod( 0555, $dir_name ) ;
  31                 },
  32
  33                 posttest => sub {
  34
  35                         chmod( 0777, $dir_name ) ;
  36                         rmdir $dir_name ;
  37                 },
  38
  39                 error => qr/open/,
  40                 skip    => 1,
  41         },
  42
  43         {
  44                 name    => 'write_file syswrite error',
  45                 sub     => \&write_file,
  46                 args    => [ $file_name, '' ],
  47                 override        => 'syswrite',
  48
  49                 posttest => sub {
  50                         unlink( $file_name ) ;
  51                 },
  52
  53
  54                 error => qr/write/,
  55                 skip    => 1,
  56         },
  57
  58         {
  59                 name    => 'read_file small sysread error',
  60                 sub     => \&read_file,
  61                 args    => [ $file_name ],
  62                 override        => 'sysread',
  63
  64                 pretest => sub {
  65                         write_file( $file_name, '' ) ;
  66                 },
  67
  68                 posttest => sub {
  69                         unlink( $file_name ) ;
  70                 },
  71
  72
  73                 error => qr/read/,
  74         },
  75
  76         {
  77                 name    => 'read_file loop sysread error',
  78                 sub     => \&read_file,
  79                 args    => [ $file_name ],
  80                 override        => 'sysread',
  81
  82                 pretest => sub {
  83                         write_file( $file_name, 'x' x 100_000 ) ;
  84                 },
  85
  86                 posttest => sub {
  87                         unlink( $file_name ) ;
  88                 },
  89
  90
  91                 error => qr/read/,
  92         },
  93
  94         {
  95                 name    => 'atomic rename error',
  96                 sub     => \&write_file,
  97                 args    => [ "$dir_name/$file_name", { atomic => 1 }, '' ],
  98                 pretest => sub {
  99                         mkdir $dir_name ;
 100                         write_file( "$dir_name/$file_name.$$", '' ) ;
 101                         chmod( 0555, $dir_name ) ;
 102                 },
 103
 104                 posttest => sub {
 105
 106                         chmod( 0777, $dir_name ) ;
 107                         unlink( "$dir_name/$file_name.$$" ) ;
 108                         rmdir $dir_name ;
 109                 },
 110
 111                 error => qr/rename/,
 112                 skip    => 1,
 113         },
 114
 115         {
 116                 name    => 'read_dir opendir error',
 117                 sub     => \&read_dir,
 118                 args    => [ $dir_name ],
 119
 120                 error => qr/open/,
 121                 skip    => 1,
 122         },
 123 ] ;
 124
 125 test_driver( $tests ) ;
 126
 127 exit ;
 128