#!./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" ],
},
);
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);
}