1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229
|
#!./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)?
# BusyBox find is non-POSIX - it doesn't have -links
my @files = sort `find '$tmpdir' '(' -name 'abc' -o -name 'acc' ')' -a -links +0`;
@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" ],
},
{
name => "[perl #113054] mapping of ?",
args => [ "-name", "a?c" ],
},
);
plan(tests => 1 + 4 * @testcases);
my $find2perl = File::Spec->catfile(File::Spec->updir(), "x2p", "find2perl");
ok (-x $find2perl, "find2perl exists");
our $TODO;
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, 4);
my $code = runperl(args => [ $find2perl, $tmpdir, @$args ]);
ok($code, "$name: run findperl")
or skip("", 3);
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);
ok(length $files, "$name: run output script")
or skip("", 2);
my $find_files;
my $source;
if ($test->{expect}) {
$find_files = join "\n",
map { $_ eq "" ? $tmpdir : "$tmpdir/$_" }
@{$test->{expect}};
$source = "expected";
# to balance the ok() in the other branch
pass("$name: got files ok");
}
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`;
ok(length $find_files, "$name: run find")
or skip("", 1);
$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);
}
|