[perl #113054] test find2perl, with a TODO for ? glob handling

1 files changed, 221 insertions, 0 deletions

diff --git a/t/x2p/find2perl.t b/t/x2p/find2perl.t
new file mode 100644
index 0000000000..b3066ab912
--- /dev/null
+++ b/t/x2p/find2perl.t
@@ -0,0 +1,221 @@
+#!./perl
+
+# Based on ideas from x2p/s2p.t
+#
+# This doesn't currently test -exec etc, just the default -print on
+# the platforms below.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = ( '../lib' );
+}
+
+use strict;
+use warnings;
+use File::Path 'remove_tree';
+use File::Spec;
+require "./test.pl";
+
+# add more platforms if you feel like it, but make sure the
+# tests below are portable to the find(1) for any new platform,
+# or that they skip on that platform
+$^O =~ /^(?:linux|\w+bsd|darwin)$/
+    or skip_all("Need something vaguely POSIX");
+
+my $VERBOSE = grep $_ eq '-v', @ARGV;
+
+my $tmpdir = tempfile();
+my $script = tempfile();
+mkdir $tmpdir
+    or die "Cannot make temp dir $tmpdir: $!";
+
+# test file names shouldn't contain any shell special characters,
+# and for portability, probably shouldn't contain any high ascii or
+# Unicode characters
+#
+# handling Unicode here would be nice, but I think handling of Unicode
+# in perl's file system interfaces (open, unlink, readdir) etc needs to
+# be more regular before we can expect interoperability between find2perl
+# and a system find(1)
+#
+# keys for the test file list:
+#   name - required
+#   type - type of file to create:
+#      "f" regular file, "d" directory, "l" link to target,
+#      "s" symlink to target
+#   atime, mtime - file times (default now)
+#   mode - file mode (default per umask)
+#   content - file content for type f files
+#   target - target for link for type l and s
+#
+# I could have simply written code to create all the files, but I think
+# this makes the file tree a little more obvious
+use constant HOUR => 3600; # an hour in seconds
+my @test_files =
+    (
+        { name => "abc" },
+        { name => "acc", mtime => time() - HOUR * 48 },
+        { name => "ac", content => "x" x 10 },
+        { name => "somedir", type => "d" },
+        { name => "link", type => "l", target => "abc" },
+        { name => "symlink", type => "s", target => "brokenlink" },
+    );
+# make some files to search
+for my $spec (@test_files) {
+    my $file = File::Spec->catfile($tmpdir, split '/', $spec->{name});
+    my $type = $spec->{type} || "f";
+    if ($type eq "f") {
+        open my $fh, ">", $file
+            or die "Cannot create test file $file: $!";
+        if ($spec->{content}) {
+            binmode $fh;
+            print $fh $spec->{content};
+        }
+        close $fh
+            or die "Cannot close $file: $!";
+    }
+    elsif ($type eq "d") {
+        mkdir $file
+            or die "Cannot create test directory $file: $!";
+    }
+    elsif ($type eq "l") {
+        my $target = File::Spec->catfile($tmpdir, split '/', $spec->{target});
+        link $target, $file
+            or die "Cannot create test link $file: $!";
+    }
+    elsif ($type eq "s") {
+        my $target = File::Spec->catfile($tmpdir, split '/', $spec->{target});
+        symlink $target, $file
+            or die "Cannot create test symlink $file: $!";
+    }
+    if ($spec->{mode}) {
+        chmod $spec->{mode}, $file
+            or die "Cannot set mode of test file $file: $!";
+    }
+    if ($spec->{mtime} || $spec->{atime}) {
+        # default the times to now, since we just created the files
+        my $mtime = $spec->{mtime} || time();
+        my $atime = $spec->{atime} || time();
+        utime $atime, $mtime, $file
+            or die "Cannot set times of test file $file: $!";
+    }
+}
+
+# do we have a vaguely sane find(1)?
+my @files = sort `find '$tmpdir' -name 'abc' -o -name 'acc'`;
+@files == 2 && $files[0] =~ /\babc\n\z/ && $files[1] =~ /\bacc\n\z/
+    or skip_all("doesn't appear to be a sane find(1)");
+
+# required keys:
+#   args - find search spec as an array ref
+# optional:
+#   name - short description of the test (defaults to args)
+#   expect - an array ref of files expected to be found (skips the find(1) call)
+#   TODO - why this test is TODO (if it is), if a code reference that is
+#          called to check if the test is TODO (and why)
+#   SKIP - return a message for why to skip
+my @testcases =
+    (
+        {
+            name => "all files",
+            args => [],
+        },
+        {
+            name => "mapping of *",
+            args => [ "-name", "a*c" ],
+        },
+        {
+            args => [ "-type", "d" ],
+            expect => [ "", "somedir" ],
+        },
+        {
+            args => [ "-type", "f" ],
+        },
+        {
+            args => [ "-mtime", "+1" ],
+            expect => [ "acc" ],
+        },
+        {
+            args => [ "-mtime", "-1" ],
+        },
+        {
+            args => [ "-size", "10c" ],
+            expect => [ "ac" ],
+        },
+        {
+            args => [ "-links", "2" ],
+            expect => [ "abc", "link", "somedir" ],
+        },
+        {
+            name => "[perl #113054] mapping of ?",
+            args => [ "-name", "a?c" ],
+            TODO => "perl #113054",
+        },
+    );
+
+my $find2perl = File::Spec->catfile(File::Spec->updir(), "x2p", "find2perl");
+our $TODO;
+plan(tests => scalar @testcases);
+for my $test (@testcases) {
+ SKIP:
+    {
+        local $TODO = $test->{TODO};
+        $TODO = $TODO->() if ref $TODO;
+        my $args = $test->{args}
+            or die "Missing test args";
+        my $name = $test->{name} || "@$args";
+
+        my $skip = $test->{SKIP} && $test->{SKIP}->();
+        $skip
+            and skip($skip, 1);
+
+        my $code = runperl(args => [ $find2perl, $tmpdir, @$args ]);
+
+        unless ($code) {
+            fail("$name: failed to run findperl");
+            next;
+        }
+
+        open my $script_fh, ">", $script
+            or die "Cannot create $script: $!";
+        print $script_fh $code;
+        close $script_fh
+            or die "Cannot close $script: $!";
+
+        my $files = runperl(progfile => $script);
+        my $find_files;
+        my $source;
+        if ($test->{expect}) {
+            $find_files = join "\n",
+                map { $_ eq "" ? $tmpdir : "$tmpdir/$_" }
+                @{$test->{expect}};
+            $source = "expected";
+        }
+        else {
+            my $findcmd = "find $tmpdir ". join " ", map "'$_'", @$args;
+
+            # make sure PERL_UNICODE doesn't reinterpret the output of find
+            use open IN => ':raw';
+            $find_files = `$findcmd`;
+            $source = "find";
+        }
+
+        # is the order from find (or find2perl) guaranteed?
+        # assume it isn't
+        $files = join("\n", sort split /\n/, $files);
+        $find_files = join("\n", sort split /\n/, $find_files);
+
+        if ($VERBOSE) {
+            note("script:\n$code");
+            note("args:\n@$args");
+            note("find2perl:\n$files");
+            note("find:\n$find_files");
+        }
+
+        is($files, $find_files, "$name: find2perl matches $source");
+    }
+}
+
+END {
+    remove_tree($tmpdir);
+}