7 use lib "$FindBin::Bin/lib";
9 use File::Copy qw(copy move cp mv);
11 use Test::More 'no_plan';
13 use constant NO_SUCH_FILE => "this_file_had_better_not_exist";
14 use constant NO_SUCH_FILE2 => "this_file_had_better_not_exist_xyzzy";
16 use constant PERL510 => ( $] >= 5.0100 );
17 use constant PERL5101 => ( $] >= 5.0101 );
18 use constant PERL5102 => ( $] >= 5.0102 );
20 # File::Copy states that all subroutines return '0' on failure.
21 # However both Windows and VMS may return other false values
22 # (notably empty-string) on failure. This constant indicates
23 # whether we should skip some tests because the return values
24 # from File::Copy may not be what's in the documentation.
26 use constant WEIRDO_FILE_COPY =>
27 ( ! PERL5102 and ( $^O eq "MSWin32" or $^O eq "VMS" ));
30 fail_on_empty fail_on_false fail_on_undef
33 use autodie qw(fail_on_empty fail_on_false fail_on_undef);
35 diag("Sub::Identify ", exists( $INC{'Sub/Identify.pm'} ) ? "is" : "is not",
36 " loaded") if (! $ENV{PERL_CORE});
38 my $hints = "autodie::hints";
42 is( $hints->sub_fullname(\©), 'File::Copy::copy' , "Id: copy" );
44 $hints->sub_fullname(\&cp),
45 PERL5101 ? 'File::Copy::cp' : 'File::Copy::copy' , "Id: cp"
48 is( $hints->sub_fullname(\&move), 'File::Copy::move' , "Id: move" );
49 is( $hints->sub_fullname(\&mv),
50 PERL5101 ? 'File::Copy::mv' : 'File::Copy::move' , "Id: mv"
54 ok( $hints->get_hints_for(\©)->{scalar}->(0) ,
55 "copy() hints should fail on 0 for scalars."
57 ok( $hints->get_hints_for(\©)->{list}->(0) ,
58 "copy() hints should fail on 0 for lists."
67 my $scalar_context = copy(NO_SUCH_FILE, NO_SUCH_FILE2);
70 isnt("$@", "", "Copying in scalar context should throw an error.");
71 isa_ok($@, "autodie::exception");
73 is($@->function, "File::Copy::copy", "Function should be original name");
76 skip("File::Copy is weird on Win32/VMS before 5.10.1", 1)
79 is($@->return, 0, "File::Copy returns zero on failure");
82 is($@->context, "scalar", "File::Copy called in scalar context");
89 my @list_context = copy(NO_SUCH_FILE, NO_SUCH_FILE2);
92 isnt("$@", "", "Copying in list context should throw an error.");
93 isa_ok($@, "autodie::exception");
95 is($@->function, "File::Copy::copy", "Function should be original name");
98 skip("File::Copy is weird on Win32/VMS before 5.10.1", 1)
101 is_deeply($@->return, [0], "File::Copy returns zero on failure");
103 is($@->context, "list", "File::Copy called in list context");
105 # Tests on loaded funcs.
109 # Test code # Exception expected?
111 'fail_on_empty()' => 1,
112 'fail_on_empty(0)' => 0,
113 'fail_on_empty(undef)' => 0,
114 'fail_on_empty(1)' => 0,
116 'fail_on_false()' => 1,
117 'fail_on_false(0)' => 1,
118 'fail_on_false(undef)' => 1,
119 'fail_on_false(1)' => 0,
121 'fail_on_undef()' => 1,
122 'fail_on_undef(0)' => 0,
123 'fail_on_undef(undef)' => 1,
124 'fail_on_undef(1)' => 0,
128 # On Perl 5.8, autodie doesn't correctly propagate into string evals.
129 # The following snippet forces the use of autodie inside the eval if
130 # we really really have to. For 5.10+, we don't want to include this
131 # fix, because the tests will act as a canary if we screw up string
137 "use autodie qw(fail_on_empty fail_on_false fail_on_undef); "
140 while (my ($test, $exception_expected) = each %tests) {
147 if ($exception_expected) {
148 isnt("$@", "", $test);