File: error.t

package info (click to toggle)
libfile-slurp-perl 9999.09-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 172 kB
  • ctags: 26
  • sloc: perl: 872; makefile: 37
file content (65 lines) | stat: -rw-r--r-- 988 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
##!/usr/local/bin/perl -w

use strict ;

use Test::More ;
use Carp ;

BEGIN{ 
	use_ok( 'File::Slurp', ) ;
}
use File::Slurp ;


my $file = 'missing/file' ;
unlink $file ;

plan tests => 9 ;

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" ) ;
}