This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert to use of Test::More. Boost test coverage.
[perl5.git] / lib / File / Compare.t
index 1b7d038..c8c730d 100644 (file)
@@ -5,6 +5,9 @@ BEGIN {
   @INC = '../lib';
 }
 
+our $TEST   = "TEST";
+our $README = "README";
+
 BEGIN {
   our @TEST = stat "TEST";
   our @README = stat "README";
@@ -14,61 +17,48 @@ BEGIN {
   }
 }
 
-print "1..13\n";
-
+use Test::More ( tests => 16 );
 use File::Compare qw(compare compare_text);
 
-print "ok 1\n";
-
-# named files, same, existing but different, cause an error
-print "not " unless compare("README","README") == 0;
-print "ok 2\n";
-
-print "not " unless compare("TEST","README") == 1;
-print "ok 3\n";
+# Upon success, compare() and compare_text() return a Unix-ish 0
+# rather than a Perl-ish 1.
 
-print "not " unless compare("README","HLAGHLAG") == -1;
-                               # a file which doesn't exist
-print "ok 4\n";
+is(compare($README,$README), 0, "compare file to itself");
+is(compare($TEST,$README), 1, "compare file to different file");
+is(compare($README,"HLAGHLAG"), -1,
+    "compare file to nonexistent file returns error value");
 
-# compare_text, the same file, different but existing files
-# cause error, test sub form.
-print "not " unless compare_text("README","README") == 0;
-print "ok 5\n";
+is(compare_text($README,$README), 0, "compare_text file to itself");
+is(compare_text($TEST,$README), 1, "compare_text file to different file");
+is(compare_text($TEST,"HLAGHLAG"), -1,
+    "compare_text file to nonexistent file returns error value");
+is(compare_text($README,$README,sub {$_[0] ne $_[1]}), 0,
+    "compare_text with code ref as third argument, file to itself");
 
-print "not " unless compare_text("TEST","README") == 1;
-print "ok 6\n";
+is(compare_text($TEST,$README,sub {$_[0] ne $_[1]}), 1,
+    "compare_text with code ref as third argument, file to different file");
 
-print "not " unless compare_text("TEST","HLAGHLAG") == -1;
-print "ok 7\n";
-
-print "not " unless
-  compare_text("README","README",sub {$_[0] ne $_[1]}) == 0;
-print "ok 8\n";
-
-# filehandle and same file
 {
-  my $fh;
-  open ($fh, "<README") or print "not ";
-  binmode($fh);
-  print "not " unless compare($fh,"README") == 0;
-  print "ok 9\n";
-  close $fh;
+    open my $fh, '<', $README
+        or die "Unable to open $README for reading: $!";
+    binmode($fh);
+    is(compare($fh,$README), 0,
+        "compare file with filehandle open to same file");
+    close $fh;
 }
 
-# filehandle and different (but existing) file.
 {
-  my $fh;
-  open ($fh, "<README") or print "not ";
-  binmode($fh);
-  print "not " unless compare_text($fh,"TEST") == 1;
-  print "ok 10\n";
-  close $fh;
+    open my $fh, '<', $README
+        or die "Unable to open $README for reading: $!";
+    binmode($fh);
+    is(compare($fh,$TEST), 1,
+        "compare file with filehandle open to different file");
+    close $fh;
 }
 
 # Different file with contents of known file,
 # will use File::Temp to do this, skip rest of
-# tests if this doesn't seem to work
+# tests if this does not seem to work
 
 my @donetests;
 eval {
@@ -83,7 +73,7 @@ eval {
   {
     local $/; #slurp
     my $fh;
-    open($fh,'README');
+    open($fh,$README);
     binmode($fh);
     my $data = <$fh>;
     print $tfh $data;
@@ -92,36 +82,59 @@ eval {
     close($tfhSP);
   }
   seek($tfh,0,0);
-  $donetests[0] = compare($tfh, 'README');
+  $donetests[0] = compare($tfh, $README);
   if ($^O eq 'VMS') {
       unlink0($tfh,$filename);  # queue for later removal
       close $tfh;               # may not be opened shared
   }
-  $donetests[1] = compare($filename, 'README');
+  $donetests[1] = compare($filename, $README);
   unlink0($tfh,$filename);
-  $donetests[2] = compare('README', "$filename$whsp");
+  $donetests[2] = compare($README, "$filename$whsp");
   unlink "$filename$whsp";
 };
 print "# problem '$@' when testing with a temporary file\n" if $@;
 
-if (@donetests == 3) {
-  print "not " unless $donetests[0] == 0;
-  print "ok 11 # fh/file [$donetests[0]]\n";
-  print "not " unless $donetests[1] == 0;
-  print "ok 12 # file/file [$donetests[1]]\n";
-  print "not " unless $donetests[2] == 0;
-  print "ok 13 # ";
-  print "TODO" if $^O eq "cygwin"; # spaces after filename silently trunc'd
-  print "TODO" if $^O eq "vos"; # spaces after filename silently trunc'd
-  print " file/fileCR [$donetests[2]]\n";
+SKIP: {
+    my $why = "Likely due to File::Temp";
+    my $how_many = 3;
+    my $have_some_feature = (@donetests == 3);
+    skip $why, $how_many unless $have_some_feature;
+
+    is($donetests[0], 0, "fh/file [$donetests[0]]");
+    is($donetests[1], 0, "file/file [$donetests[1]]");
+    TODO: {
+        my $why = "spaces after filename silently truncated";
+        my $how_many = 1;
+        my $condition = ($^O eq "cygwin") or ($^O eq "vos");
+        todo_skip $why, $how_many if $condition;
+        is($donetests[2], 0, "file/fileCR [$donetests[2]]");
+    }
 }
-else {
-  print "ok 11# Skip\nok 12 # Skip\nok 13 # Skip Likely due to File::Temp\n";
+
+{
+    local $@;
+    eval { compare(); 1 };
+    like($@, qr/Usage:\s+compare/,
+        "detect insufficient arguments to compare()");
+}
+
+{
+    local $@;
+    eval { compare(undef, $README); 1 };
+    like($@, qr/from\s+undefined/,
+        "compare() fails: first argument undefined");
+}
+
+{
+    local $@;
+    eval { compare($README, undef ); 1 };
+    like($@, qr/to\s+undefined/,
+        "compare() fails: second argument undefined");
 }
 
 sub get_valid_whitespace {
     return ' ' unless $^O eq 'VMS';
-    return (exists $ENV{'DECC$EFS_CHARSET'} && $ENV{'DECC$EFS_CHARSET'} =~ /^[ET1]/i) 
+    return (exists $ENV{'DECC$EFS_CHARSET'} && $ENV{'DECC$EFS_CHARSET'} =~ /^[ET1]/i)
            ? ' '
            : '_';  # traditional mode eats spaces in filenames
 }