update t/error_mode.t

perhunter · Sep 28, 2018 · 4d04e8d · 4d04e8d
1 parent ba4cc0f
commit 4d04e8d
Show file tree

Hide file tree

Showing 2 changed files with 102 additions and 50 deletions.
diff --git a/Changes b/Changes
@@ -10,6 +10,7 @@ Revision history File::Slurp
 	- Update t/binmode.t
 	- Update t/data_list.t
 	- Update t/data_scalar.t
+	- Update t/error_mode.t
 
 9999.19	  Tue Jun  7 04:06:06 EDT 2011
 	- Fixed use line in t/edit_file.t to import :edit first

diff --git a/t/error_mode.t b/t/error_mode.t
@@ -1,59 +1,110 @@
-##!/usr/local/bin/perl -w
-
-use strict ;
-use File::Slurp ;
-
-use Carp ;
-use Test::More tests => 9 ;
-
-my $file = 'missing/file' ;
-#unlink $file ;
-
-
-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 ) ;
+use strict;
+use warnings;
+
+use Carp;
+use File::Spec ();
+use File::Slurp;
+# use File::Temp qw(tempfile);
+use IO::Handle ();
+use Test::More;
+
+plan tests => 27;
+
+{ # read_dir errors
+    # this one intentionally doesn't exist on a couple of paths. can't be created.
+    my $file = File::Spec->catfile(File::Spec->tmpdir, 'super', 'bad', 'file-spec', 'path');
+    my ($res, $warn, $err) = trap_read_dir($file, 'quiet');
+    ok(!$warn, 'read_dir: err_mode opt quiet - no warn!');
+    ok(!$err, 'read_dir: err_mode opt quiet - no exception!');
+    ok(!$res, 'read_dir: err_mode opt quiet - no content!');
+    ($res, $warn, $err) = trap_read_dir($file, 'carp');
+    ok($warn, 'read_dir: err_mode opt carp - got warn!');
+    ok(!$err, 'read_dir: err_mode opt carp - no exception!');
+    ok(!$res, 'read_dir: err_mode opt carp - no content!');
+    ($res, $warn, $err) = trap_read_dir($file, 'croak');
+    ok(!$warn, 'read_dir: err_mode opt croak - no warn!');
+    ok($err, 'read_dir: err_mode opt croak - got exception!');
+    ok(!$res, 'read_dir: err_mode opt croak - no content!');
 }
 
-
-sub test_croak {
-
-	my ( $name, $sub, @args ) = @_ ;
-
-	eval {
-		$sub->( @args ) ;
-	} ;
-
-	ok( $@, "$name can croak" ) ;
+{ # read_file errors
+    # this one intentionally doesn't exist on a couple of paths. can't be created.
+    my $file = File::Spec->catfile(File::Spec->tmpdir, 'super', 'bad', 'file-spec', 'path');
+    my ($res, $warn, $err) = trap_read_file($file, 'quiet');
+    ok(!$warn, 'read_file: err_mode opt quiet - no warn!');
+    ok(!$err, 'read_file: err_mode opt quiet - no exception!');
+    ok(!$res, 'read_file: err_mode opt quiet - no content!');
+    ($res, $warn, $err) = trap_read_file($file, 'carp');
+    ok($warn, 'read_file: err_mode opt carp - got warn!');
+    ok(!$err, 'read_file: err_mode opt carp - no exception!');
+    ok(!$res, 'read_file: err_mode opt carp - no content!');
+    ($res, $warn, $err) = trap_read_file($file, 'croak');
+    ok(!$warn, 'read_file: err_mode opt croak - no warn!');
+    ok($err, 'read_file: err_mode opt croak - got exception!');
+    ok(!$res, 'read_file: err_mode opt croak - no content!');
 }
 
-sub test_carp {
-
-	my ( $name, $sub, @args ) = @_ ;
-
-	local $SIG{__WARN__} = sub { ok( 1, "$name can carp" ) } ;
-
-	$sub->( @args ) ;
+{ # write_file errors
+    # this one intentionally doesn't exist on a couple of paths. can't be created.
+    my $file = File::Spec->catfile(File::Spec->tmpdir, 'super', 'bad', 'file-spec', 'path');
+    my ($res, $warn, $err) = trap_write_file($file, 'quiet');
+    ok(!$warn, 'write_file: err_mode opt quiet - no warn!');
+    ok(!$err, 'write_file: err_mode opt quiet - no exception!');
+    ok(!$res, 'write_file: err_mode opt quiet - no content!');
+    ($res, $warn, $err) = trap_write_file($file, 'carp');
+    ok($warn, 'write_file: err_mode opt carp - got warn!');
+    ok(!$err, 'write_file: err_mode opt carp - no exception!');
+    ok(!$res, 'write_file: err_mode opt carp - no content!');
+    ($res, $warn, $err) = trap_write_file($file, 'croak');
+    ok(!$warn, 'write_file: err_mode opt croak - no warn!');
+    ok($err, 'write_file: err_mode opt croak - got exception!');
+    ok(!$res, 'write_file: err_mode opt croak - no content!');
 }
 
-sub test_quiet {
-
-	my ( $name, $sub, @args ) = @_ ;
-
-	local $SIG{__WARN__} = sub { ok( 0, "$name can be quiet" ) } ;
+sub trap_read_dir {
+    my ($file, $mode) = @_;
+    my $res;
+    my $warn;
+    my $err = do { # catch
+        local $@;
+        local $SIG{__WARN__} = sub {$warn = join '', @_};
+        eval { # try
+            $res = read_dir($file, err_mode => $mode);
+            1;
+        };
+        $@;
+    };
+    return ($res, $warn, $err);
+}
 
-	eval {
-		$sub->( @args ) ;
-	} ;
+sub trap_read_file {
+    my ($file, $mode) = @_;
+    my $res;
+    my $warn;
+    my $err = do { # catch
+        local $@;
+        local $SIG{__WARN__} = sub {$warn = join '', @_};
+        eval { # try
+            $res = read_file($file, err_mode => $mode);
+            1;
+        };
+        $@;
+    };
+    return ($res, $warn, $err);
+}
 
-	ok( !$@, "$name can be quiet" ) ;
+sub trap_write_file {
+    my ($file, $mode) = @_;
+    my $res;
+    my $warn;
+    my $err = do { # catch
+        local $@;
+        local $SIG{__WARN__} = sub {$warn = join '', @_};
+        eval { # try
+            $res = write_file($file, {err_mode => $mode}, 'junk');
+            1;
+        };
+        $@;
+    };
+    return ($res, $warn, $err);
 }