cpan/File-Path/t/Path.t

   1 #! /usr/bin/env perl
   2 # Path.t -- tests for module File::Path
   3
   4 use strict;
   5
   6 use Test::More tests => 127;
   7 use Config;
   8 use Fcntl ':mode';
   9 use lib 't/';
  10 use FilePathTest;
  11
  12 BEGIN {
  13     use_ok('Cwd');
  14     use_ok('File::Path', qw(rmtree mkpath make_path remove_tree));
  15     use_ok('File::Spec::Functions');
  16 }
  17
  18 my $Is_VMS = $^O eq 'VMS';
  19
  20 # first check for stupid permissions second for full, so we clean up
  21 # behind ourselves
  22 for my $perm (0111,0777) {
  23     my $path = catdir(curdir(), "mhx", "bar");
  24     mkpath($path);
  25     chmod $perm, "mhx", $path;
  26
  27     my $oct = sprintf('0%o', $perm);
  28
  29     ok(-d "mhx", "mkdir parent dir $oct");
  30     ok(-d $path, "mkdir child dir $oct");
  31
  32     rmtree("mhx");
  33
  34     ok(! -e "mhx", "mhx does not exist $oct");
  35 }
  36
  37 # find a place to work
  38 my ($error, $list, $file, $message);
  39 my $tmp_base = catdir(
  40     curdir(),
  41     sprintf( 'test-%x-%x-%x', time, $$, rand(99999) ),
  42 );
  43
  44 # invent some names
  45 my @dir = (
  46     catdir($tmp_base, qw(a b)),
  47     catdir($tmp_base, qw(a c)),
  48     catdir($tmp_base, qw(z b)),
  49     catdir($tmp_base, qw(z c)),
  50 );
  51
  52 # create them
  53 my @created = mkpath([@dir]);
  54
  55 is(scalar(@created), 7, "created list of directories");
  56
  57 # pray for no race conditions blowing them out from under us
  58 @created = mkpath([$tmp_base]);
  59 is(scalar(@created), 0, "skipped making existing directory")
  60     or diag("unexpectedly recreated @created");
  61
  62 # create a file
  63 my $file_name = catfile( $tmp_base, 'a', 'delete.me' );
  64 my $file_count = 0;
  65 if (open OUT, "> $file_name") {
  66     print OUT "this file may be deleted\n";
  67     close OUT;
  68     ++$file_count;
  69 }
  70 else {
  71     diag( "Failed to create file $file_name: $!" );
  72 }
  73
  74 SKIP: {
  75     skip "cannot remove a file we failed to create", 1
  76         unless $file_count == 1;
  77     my $count = rmtree($file_name);
  78     is($count, 1, "rmtree'ed a file");
  79 }
  80
  81 @created = mkpath('');
  82 is(scalar(@created), 0, "Can't create a directory named ''");
  83
  84 my $dir;
  85 my $dir2;
  86
  87 sub gisle {
  88     # background info: @_ = 1; !shift # gives '' not 0
  89     # Message-Id: <3C820CE6-4400-4E91-AF43-A3D19B356E68@activestate.com>
  90     # http://www.nntp.perl.org/group/perl.perl5.porters/2008/05/msg136625.html
  91     mkpath(shift, !shift, 0755);
  92 }
  93
  94 sub count {
  95     opendir D, shift or return -1;
  96     my $count = () = readdir D;
  97     closedir D or return -1;
  98     return $count;
  99 }
 100
 101 {
 102     mkdir 'solo', 0755;
 103     chdir 'solo';
 104     open my $f, '>', 'foo.dat';
 105     close $f;
 106     my $before = count(curdir());
 107     cmp_ok($before, '>', 0, "baseline $before");
 108
 109     gisle('1st', 1);
 110     is(count(curdir()), $before + 1, "first after $before");
 111
 112     $before = count(curdir());
 113     gisle('2nd', 1);
 114
 115     is(count(curdir()), $before + 1, "second after $before");
 116
 117     chdir updir();
 118     rmtree 'solo';
 119 }
 120
 121 {
 122     mkdir 'solo', 0755;
 123     chdir 'solo';
 124     open my $f, '>', 'foo.dat';
 125     close $f;
 126     my $before = count(curdir());
 127
 128     cmp_ok($before, '>', 0, "ARGV $before");
 129     {
 130         local @ARGV = (1);
 131         mkpath('3rd', !shift, 0755);
 132     }
 133
 134     is(count(curdir()), $before + 1, "third after $before");
 135
 136     $before = count(curdir());
 137     {
 138         local @ARGV = (1);
 139         mkpath('4th', !shift, 0755);
 140     }
 141
 142     is(count(curdir()), $before + 1, "fourth after $before");
 143
 144     chdir updir();
 145     rmtree 'solo';
 146 }
 147
 148 SKIP: {
 149     # tests for rmtree() of ancestor directory
 150     my $nr_tests = 6;
 151     my $cwd = getcwd() or skip "failed to getcwd: $!", $nr_tests;
 152     my $dir  = catdir($cwd, 'remove');
 153     my $dir2 = catdir($cwd, 'remove', 'this', 'dir');
 154
 155     skip "failed to mkpath '$dir2': $!", $nr_tests
 156         unless mkpath($dir2, {verbose => 0});
 157     skip "failed to chdir dir '$dir2': $!", $nr_tests
 158         unless chdir($dir2);
 159
 160     rmtree($dir, {error => \$error});
 161     my $nr_err = @$error;
 162
 163     is($nr_err, 1, "ancestor error");
 164
 165     if ($nr_err) {
 166         my ($file, $message) = each %{$error->[0]};
 167
 168         is($file, $dir, "ancestor named");
 169         my $ortho_dir = $^O eq 'MSWin32' ? File::Path::_slash_lc($dir2) : $dir2;
 170         $^O eq 'MSWin32' and $message
 171             =~ s/\A(cannot remove path when cwd is )(.*)\Z/$1 . File::Path::_slash_lc($2)/e;
 172
 173         is($message, "cannot remove path when cwd is $ortho_dir", "ancestor reason");
 174
 175         ok(-d $dir2, "child not removed");
 176
 177         ok(-d $dir, "ancestor not removed");
 178     }
 179     else {
 180         fail( "ancestor 1");
 181         fail( "ancestor 2");
 182         fail( "ancestor 3");
 183         fail( "ancestor 4");
 184     }
 185     chdir $cwd;
 186     rmtree($dir);
 187
 188     ok(!(-d $dir), "ancestor now removed");
 189 };
 190
 191 my $count = rmtree({error => \$error});
 192
 193 is( $count, 0, 'rmtree of nothing, count of zero' );
 194
 195 is( scalar(@$error), 0, 'no diagnostic captured' );
 196
 197 @created = mkpath($tmp_base, 0);
 198
 199 is(scalar(@created), 0, "skipped making existing directories (old style 1)")
 200     or diag("unexpectedly recreated @created");
 201
 202 $dir = catdir($tmp_base,'C');
 203 # mkpath returns unix syntax filespecs on VMS
 204 $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 205 @created = make_path($tmp_base, $dir);
 206
 207 is(scalar(@created), 1, "created directory (new style 1)");
 208
 209 is($created[0], $dir, "created directory (new style 1) cross-check");
 210
 211 @created = mkpath($tmp_base, 0, 0700);
 212
 213 is(scalar(@created), 0, "skipped making existing directories (old style 2)")
 214     or diag("unexpectedly recreated @created");
 215
 216 $dir2 = catdir($tmp_base,'D');
 217 # mkpath returns unix syntax filespecs on VMS
 218 $dir2 = VMS::Filespec::unixify($dir2) if $Is_VMS;
 219 @created = make_path($tmp_base, $dir, $dir2);
 220
 221 is(scalar(@created), 1, "created directory (new style 2)");
 222
 223 is($created[0], $dir2, "created directory (new style 2) cross-check");
 224
 225 $count = rmtree($dir, 0);
 226
 227 is($count, 1, "removed directory unsafe mode");
 228
 229 my $expected_count = _cannot_delete_safe_mode($dir2) ? 0 : 1;
 230
 231 $count = rmtree($dir2, 0, 1);
 232
 233 is($count, $expected_count, "removed directory safe mode");
 234
 235 # mkdir foo ./E/../Y
 236 # Y should exist
 237 # existence of E is neither here nor there
 238 $dir = catdir($tmp_base, 'E', updir(), 'Y');
 239 @created =mkpath($dir);
 240
 241 cmp_ok(scalar(@created), '>=', 1, "made one or more dirs because of ..");
 242
 243 cmp_ok(scalar(@created), '<=', 2, "made less than two dirs because of ..");
 244
 245 ok( -d catdir($tmp_base, 'Y'), "directory after parent" );
 246
 247 @created = make_path(catdir(curdir(), $tmp_base));
 248
 249 is(scalar(@created), 0, "nothing created")
 250     or diag(@created);
 251
 252 $dir  = catdir($tmp_base, 'a');
 253 $dir2 = catdir($tmp_base, 'z');
 254
 255 rmtree( $dir, $dir2,
 256     {
 257         error     => \$error,
 258         result    => \$list,
 259         keep_root => 1,
 260     }
 261 );
 262
 263
 264 is(scalar(@$error), 0, "no errors unlinking a and z");
 265
 266 is(scalar(@$list),  4, "list contains 4 elements")
 267     or diag("@$list");
 268
 269 ok(-d $dir,  "dir a still exists");
 270
 271 ok(-d $dir2, "dir z still exists");
 272
 273 $dir = catdir($tmp_base,'F');
 274 # mkpath returns unix syntax filespecs on VMS
 275 $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 276
 277 @created = mkpath($dir, undef, 0770);
 278
 279 is(scalar(@created), 1, "created directory (old style 2 verbose undef)");
 280
 281 is($created[0], $dir, "created directory (old style 2 verbose undef) cross-check");
 282
 283 is(rmtree($dir, undef, 0), 1, "removed directory 2 verbose undef");
 284
 285 @created = mkpath($dir, undef);
 286
 287 is(scalar(@created), 1, "created directory (old style 2a verbose undef)");
 288
 289 is($created[0], $dir, "created directory (old style 2a verbose undef) cross-check");
 290
 291 is(rmtree($dir, undef), 1, "removed directory 2a verbose undef");
 292
 293 @created = mkpath($dir, 0, undef);
 294
 295 is(scalar(@created), 1, "created directory (old style 3 mode undef)");
 296
 297 is($created[0], $dir, "created directory (old style 3 mode undef) cross-check");
 298
 299 is(rmtree($dir, 0, undef), 1, "removed directory 3 verbose undef");
 300
 301 $dir = catdir($tmp_base,'G');
 302 $dir = VMS::Filespec::unixify($dir) if $Is_VMS;
 303
 304 @created = mkpath($dir, undef, 0200);
 305
 306 is(scalar(@created), 1, "created write-only dir");
 307
 308 is($created[0], $dir, "created write-only directory cross-check");
 309
 310 is(rmtree($dir), 1, "removed write-only dir");
 311
 312 # borderline new-style heuristics
 313 if (chdir $tmp_base) {
 314     pass("chdir to temp dir");
 315 }
 316 else {
 317     fail("chdir to temp dir: $!");
 318 }
 319
 320 $dir   = catdir('a', 'd1');
 321 $dir2  = catdir('a', 'd2');
 322
 323 @created = make_path( $dir, 0, $dir2 );
 324
 325 is(scalar @created, 3, 'new-style 3 dirs created');
 326
 327 $count = remove_tree( $dir, 0, $dir2, );
 328
 329 is($count, 3, 'new-style 3 dirs removed');
 330
 331 @created = make_path( $dir, $dir2, 1 );
 332
 333 is(scalar @created, 3, 'new-style 3 dirs created (redux)');
 334
 335 $count = remove_tree( $dir, $dir2, 1 );
 336
 337 is($count, 3, 'new-style 3 dirs removed (redux)');
 338
 339 @created = make_path( $dir, $dir2 );
 340
 341 is(scalar @created, 2, 'new-style 2 dirs created');
 342
 343 $count = remove_tree( $dir, $dir2 );
 344
 345 is($count, 2, 'new-style 2 dirs removed');
 346
 347 $dir = catdir("a\nb", 'd1');
 348 $dir2 = catdir("a\nb", 'd2');
 349
 350 SKIP: {
 351   # Better to search for *nix derivatives?
 352   # Not sure what else doesn't support newline in paths
 353   skip "$^O doesn't allow newline in paths", 2
 354     if $^O =~ m/^(MSWin32|VMS)$/;
 355
 356   @created = make_path( $dir, $dir2 );
 357
 358   is(scalar @created, 3, 'new-style 3 dirs created in parent with newline');
 359
 360   $count = remove_tree( $dir, $dir2 );
 361
 362   is($count, 2, 'new-style 2 dirs removed in parent with newline');
 363 }
 364
 365 if (chdir updir()) {
 366     pass("chdir parent");
 367 }
 368 else {
 369     fail("chdir parent: $!");
 370 }
 371
 372 SKIP: {
 373     # test bug http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=487319
 374     skip "Don't need Force_Writeable semantics on $^O", 6
 375         if grep {$^O eq $_} qw(amigaos dos epoc MSWin32 MacOS os2);
 376     skip "Symlinks not available", 6 unless $Config{d_symlink};
 377     $dir  = 'bug487319';
 378     $dir2 = 'bug487319-symlink';
 379     @created = make_path($dir, {mask => 0700});
 380
 381     is( scalar @created, 1, 'bug 487319 setup' );
 382     symlink($dir, $dir2);
 383
 384     ok(-e $dir2, "debian bug 487319 setup symlink") or diag($dir2);
 385
 386     chmod 0500, $dir;
 387     my $mask_initial = (stat $dir)[2];
 388     remove_tree($dir2);
 389
 390     my $mask = (stat $dir)[2];
 391
 392     is( $mask, $mask_initial, 'mask of symlink target dir unchanged (debian bug 487319)');
 393
 394     # now try a file
 395     #my $file = catfile($dir, 'file');
 396     my $file  = 'bug487319-file';
 397     my $file2 = 'bug487319-file-symlink';
 398     open my $out, '>', $file;
 399     close $out;
 400
 401     ok(-e $file, 'file exists');
 402
 403     chmod 0500, $file;
 404     $mask_initial = (stat $file)[2];
 405
 406     symlink($file, $file2);
 407
 408     ok(-e $file2, 'file2 exists');
 409     remove_tree($file2);
 410
 411     $mask = (stat $file)[2];
 412
 413     is( $mask, $mask_initial, 'mask of symlink target file unchanged (debian bug 487319)');
 414
 415     remove_tree($dir);
 416     remove_tree($file);
 417 }
 418
 419 # see what happens if a file exists where we want a directory
 420 SKIP: {
 421     my $entry = catfile($tmp_base, "file");
 422     skip "VMS can have a file and a directory with the same name.", 4
 423         if $Is_VMS;
 424     skip "Cannot create $entry", 4 unless open OUT, "> $entry";
 425     print OUT "test file, safe to delete\n", scalar(localtime), "\n";
 426     close OUT;
 427     ok(-e $entry, "file exists in place of directory");
 428
 429     mkpath( $entry, {error => \$error} );
 430     is( scalar(@$error), 1, "caught error condition" );
 431     ($file, $message) = each %{$error->[0]};
 432     is( $entry, $file, "and the message is: $message");
 433
 434     eval {@created = mkpath($entry, 0, 0700)};
 435     $error = $@;
 436     chomp $error; # just to remove silly # in TAP output
 437     cmp_ok( $error, 'ne', "", "no directory created (old-style) err=$error" )
 438         or diag(@created);
 439 }
 440
 441 {
 442     $dir = catdir($tmp_base, 'ZZ');
 443     @created = mkpath($dir);
 444     is(scalar(@created), 1, "create a ZZ directory");
 445
 446     local @ARGV = ($dir);
 447     rmtree( [grep -e $_, @ARGV], 0, 0 );
 448     ok(!-e $dir, "blow it away via \@ARGV");
 449 }
 450
 451 SKIP : {
 452     my $skip_count = 19;
 453     # this test will fail on Windows, as per:
 454     #   http://perldoc.perl.org/perlport.html#chmod
 455
 456     skip "Windows chmod test skipped", $skip_count
 457         if $^O eq 'MSWin32';
 458     my $mode;
 459     my $octal_mode;
 460     my @inputs = (
 461       0777, 0700, 0070, 0007,
 462       0333, 0300, 0030, 0003,
 463       0111, 0100, 0010, 0001,
 464       0731, 0713, 0317, 0371, 0173, 0137,
 465       00 );
 466     my $input;
 467     my $octal_input;
 468     $dir = catdir($tmp_base, 'chmod_test');
 469
 470     foreach (@inputs) {
 471         $input = $_;
 472         # We can skip from here because 0 is last in the list.
 473         skip "Mode of 0 means assume user defaults on VMS", 1
 474           if ($input == 0 && $Is_VMS);
 475         @created = mkpath($dir, {chmod => $input});
 476         $mode = (stat($dir))[2];
 477         $octal_mode = S_IMODE($mode);
 478         $octal_input = sprintf "%04o", S_IMODE($input);
 479         is($octal_mode,$input, "create a new directory with chmod $input ($octal_input)");
 480         rmtree( $dir );
 481     }
 482 }
 483
 484 my $dir_base = catdir($tmp_base,'output');
 485 my $dir_a    = catdir($dir_base, 'A');
 486 my $dir_b    = catdir($dir_base, 'B');
 487
 488 is(_run_for_verbose(sub {@created = mkpath($dir_a, 1)}),
 489     _verbose_expected('mkpath', $dir_base, 0, 1)
 490     . _verbose_expected('mkpath', $dir_a, 0),
 491     'mkpath verbose (old style 1)'
 492 );
 493
 494 is(_run_for_verbose(sub {@created = mkpath([$dir_b], 1)}),
 495     _verbose_expected('mkpath', $dir_b, 0),
 496     'mkpath verbose (old style 2)'
 497 );
 498
 499 my $verbose_expected;
 500
 501 # Must determine expectations while directories still exist.
 502 $verbose_expected = _verbose_expected('rmtree', $dir_a, 1)
 503                   . _verbose_expected('rmtree', $dir_b, 1);
 504
 505 is(_run_for_verbose(sub {$count = rmtree([$dir_a, $dir_b], 1, 1)}),
 506     $verbose_expected,
 507     'rmtree verbose (old style)'
 508 );
 509
 510 # In case we didn't delete them in safe mode.
 511 rmtree($dir_a) if -d $dir_a;
 512 rmtree($dir_b) if -d $dir_b;
 513
 514 is(_run_for_verbose(sub {@created = mkpath( $dir_a,
 515                                             {verbose => 1, mask => 0750})}),
 516     _verbose_expected('mkpath', $dir_a, 0),
 517     'mkpath verbose (new style 1)'
 518 );
 519
 520 is(_run_for_verbose(sub {@created = mkpath($dir_b, 1, 0771)}),
 521     _verbose_expected('mkpath', $dir_b, 0),
 522     'mkpath verbose (new style 2)'
 523 );
 524
 525 $verbose_expected = _verbose_expected('rmtree', $dir_a, 1)
 526                   . _verbose_expected('rmtree', $dir_b, 1);
 527
 528 is(_run_for_verbose(sub {$count = rmtree([$dir_a, $dir_b], 1, 1)}),
 529     $verbose_expected,
 530     'again: rmtree verbose (old style)'
 531 );
 532
 533 rmtree($dir_a) if -d $dir_a;
 534 rmtree($dir_b) if -d $dir_b;
 535
 536 is(_run_for_verbose(sub {@created = make_path( $dir_a, $dir_b,
 537                                                {verbose => 1, mode => 0711});}),
 538       _verbose_expected('make_path', $dir_a, 1)
 539     . _verbose_expected('make_path', $dir_b, 1),
 540     'make_path verbose with final hashref'
 541 );
 542
 543 $verbose_expected = _verbose_expected('remove_tree', $dir_a, 0)
 544                   . _verbose_expected('remove_tree', $dir_b, 0);
 545
 546 is(_run_for_verbose(sub {@created = remove_tree( $dir_a, $dir_b,
 547                                                  {verbose => 1});}),
 548     $verbose_expected,
 549     'remove_tree verbose with final hashref'
 550 );
 551
 552 rmtree($dir_a) if -d $dir_a;
 553 rmtree($dir_b) if -d $dir_b;
 554
 555 # Have to re-create these 2 directories so that next block is not skipped.
 556 @created = make_path(
 557     $dir_a,
 558     $dir_b,
 559     { mode => 0711 }
 560 );
 561 is(@created, 2, "2 directories created");
 562
 563 SKIP: {
 564     $file = catfile($dir_b, "file");
 565     skip "Cannot create $file", 2 unless open OUT, "> $file";
 566     print OUT "test file, safe to delete\n", scalar(localtime), "\n";
 567     close OUT;
 568
 569     $verbose_expected = _verbose_expected('rmtree', $dir_a, 1)
 570                       . _verbose_expected('unlink', $file, 0)
 571                       . _verbose_expected('rmtree', $dir_b, 1);
 572
 573     ok(-e $file, "file created in directory");
 574
 575     is(_run_for_verbose(sub {$count = rmtree( $dir_a, $dir_b,
 576                                               {verbose => 1, safe => 1})}),
 577         $verbose_expected,
 578         'rmtree safe verbose (new style)'
 579     );
 580     rmtree($dir_a) if -d $dir_a;
 581     rmtree($dir_b) if -d $dir_b;
 582 }
 583
 584 {
 585     my $base = catdir( $tmp_base, 'output2');
 586     my $dir  = catdir( $base, 'A');
 587     my $dir2 = catdir( $base, 'B');
 588
 589     {
 590         my $warn;
 591         $SIG{__WARN__} = sub { $warn = shift };
 592
 593         my @created = make_path(
 594             $dir,
 595             $dir2,
 596             { mode => 0711, foo => 1, bar => 1 }
 597         );
 598         like($warn,
 599             qr/Unrecognized option\(s\) passed to make_path\(\):.*?bar.*?foo/,
 600             'make_path with final hashref warned due to unrecognized options'
 601         );
 602     }
 603
 604     {
 605         my $warn;
 606         $SIG{__WARN__} = sub { $warn = shift };
 607
 608         my @created = remove_tree(
 609             $dir,
 610             $dir2,
 611             { foo => 1, bar => 1 }
 612         );
 613         like($warn,
 614             qr/Unrecognized option\(s\) passed to remove_tree\(\):.*?bar.*?foo/,
 615             'remove_tree with final hashref failed due to unrecognized options'
 616         );
 617     }
 618 }
 619
 620 SKIP: {
 621     my $nr_tests = 6;
 622     my $cwd = getcwd() or skip "failed to getcwd: $!", $nr_tests;
 623     rmtree($tmp_base, {result => \$list} );
 624     is(ref($list), 'ARRAY', "received a final list of results");
 625     ok( !(-d $tmp_base), "test base directory gone" );
 626
 627     my $p = getcwd();
 628     my $x = "x$$";
 629     my $xx = $x . "x";
 630
 631     # setup
 632     ok(mkpath($xx), "make $xx");
 633     ok(chdir($xx), "... and chdir $xx");
 634     END {
 635 #         ok(chdir($p), "... now chdir $p");
 636 #         ok(rmtree($xx), "... and finally rmtree $xx");
 637        chdir($p);
 638        rmtree($xx);
 639     }
 640
 641     # create and delete directory
 642     my $px = catdir($p, $x);
 643     ok(mkpath($px), 'create and delete directory 2.07');
 644     ok(rmtree($px), '.. rmtree fails in File-Path-2.07');
 645     chdir updir();
 646 }
 647
 648 my $windows_dir = 'C:\Path\To\Dir';
 649 my $expect = 'c:/path/to/dir';
 650 is(
 651     File::Path::_slash_lc($windows_dir),
 652     $expect,
 653     "Windows path unixified as expected"
 654 );
 655
 656 {
 657     my ($x, $message, $object, $expect, $rv, $arg, $error);
 658     my ($k, $v, $second_error, $third_error);
 659     local $! = 2;
 660     $x = $!;
 661
 662     $message = 'message in a bottle';
 663     $object = '/path/to/glory';
 664     $expect = "$message for $object: $x";
 665     $rv = _run_for_warning( sub {
 666         File::Path::_error(
 667             {},
 668             $message,
 669             $object
 670         );
 671     } );
 672     like($rv, qr/^$expect/,
 673         "no \$arg->{error}: defined 2nd and 3rd args: got expected error message");
 674
 675     $object = undef;
 676     $expect = "$message: $x";
 677     $rv = _run_for_warning( sub {
 678         File::Path::_error(
 679             {},
 680             $message,
 681             $object
 682         );
 683     } );
 684     like($rv, qr/^$expect/,
 685         "no \$arg->{error}: defined 2nd arg; undefined 3rd arg: got expected error message");
 686
 687     $message = 'message in a bottle';
 688     $object = undef;
 689     $expect = "$message: $x";
 690     $arg = { error => \$error };
 691     File::Path::_error(
 692         $arg,
 693         $message,
 694         $object
 695     );
 696     is(ref($error->[0]), 'HASH',
 697         "first element of array inside \$error is hashref");
 698     ($k, $v) = %{$error->[0]};
 699     is($k, '', 'key of hash is empty string, since 3rd arg was undef');
 700     is($v, $expect, "value of hash is 2nd arg: $message");
 701
 702     $message = '';
 703     $object = '/path/to/glory';
 704     $expect = "$message: $x";
 705     $arg = { error => \$second_error };
 706     File::Path::_error(
 707         $arg,
 708         $message,
 709         $object
 710     );
 711     is(ref($second_error->[0]), 'HASH',
 712         "first element of array inside \$second_error is hashref");
 713     ($k, $v) = %{$second_error->[0]};
 714     is($k, $object, "key of hash is '$object', since 3rd arg was defined");
 715     is($v, $expect, "value of hash is 2nd arg: $message");
 716
 717     $message = '';
 718     $object = undef;
 719     $expect = "$message: $x";
 720     $arg = { error => \$third_error };
 721     File::Path::_error(
 722         $arg,
 723         $message,
 724         $object
 725     );
 726     is(ref($third_error->[0]), 'HASH',
 727         "first element of array inside \$third_error is hashref");
 728     ($k, $v) = %{$third_error->[0]};
 729     is($k, '', "key of hash is empty string, since 3rd arg was undef");
 730     is($v, $expect, "value of hash is 2nd arg: $message");
 731 }