This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade File::Path from version 2.11 to 2.12
[perl5.git] / 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 }