t/error.t

   1 ##!/usr/local/bin/perl -w
   2
   3 use lib qw(t) ;
   4
   5 use strict ;
   6 use File::Slurp qw( :all ) ;
   7
   8 use common ;
   9
  10 my $file_name = 'test_file' ;
  11 my $dir_name = 'test_dir' ;
  12
  13 my $tests = [
  14
  15         {
  16                 name    => 'read_file open error',
  17                 sub     => \&read_file,
  18                 args    => [ $file_name ],
  19
  20                 error => qr/open/,
  21         },
  22
  23         {
  24                 name    => 'write_file open error',
  25                 sub     => \&write_file,
  26                 args    => [ "$dir_name/$file_name", '' ],
  27                 pretest => sub {
  28                         mkdir $dir_name ;
  29                         chmod( 0555, $dir_name ) ;
  30                 },
  31
  32                 posttest => sub {
  33
  34                         chmod( 0777, $dir_name ) ;
  35                         rmdir $dir_name ;
  36                 },
  37
  38                 error => qr/open/,
  39         },
  40
  41         {
  42                 name    => 'atomic rename error',
  43                 sub     => \&write_file,
  44                 args    => [ "$dir_name/$file_name", { atomic => 1 }, '' ],
  45                 pretest => sub {
  46                         mkdir $dir_name ;
  47                         write_file( "$dir_name/$file_name.$$", '' ) ;
  48                         chmod( 0555, $dir_name ) ;
  49                 },
  50
  51                 posttest => sub {
  52
  53                         chmod( 0777, $dir_name ) ;
  54                         unlink( "$dir_name/$file_name.$$" ) ;
  55                         rmdir $dir_name ;
  56                 },
  57
  58                 error => qr/rename/,
  59         },
  60
  61         {
  62                 name    => 'read_dir open error',
  63                 sub     => \&read_dir,
  64                 args    => [ $dir_name ],
  65
  66                 error => qr/open/,
  67         },
  68
  69 ] ;
  70
  71 tester( $tests ) ;
  72
  73 exit ;
  74