This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix O_CREAT without O_TRUNC in cpan/autodie/t/utf8_open.t
[perl5.git] / t / x2p / find2perl.t
CommitLineData
bdbb33c8
TC
1#!./perl
2
3# Based on ideas from x2p/s2p.t
4#
5# This doesn't currently test -exec etc, just the default -print on
6# the platforms below.
7
8BEGIN {
9 chdir 't' if -d 't';
10 @INC = ( '../lib' );
11}
12
13use strict;
14use warnings;
15use File::Path 'remove_tree';
16use File::Spec;
17require "./test.pl";
18
19# add more platforms if you feel like it, but make sure the
20# tests below are portable to the find(1) for any new platform,
21# or that they skip on that platform
22$^O =~ /^(?:linux|\w+bsd|darwin)$/
23 or skip_all("Need something vaguely POSIX");
24
25my $VERBOSE = grep $_ eq '-v', @ARGV;
26
27my $tmpdir = tempfile();
28my $script = tempfile();
29mkdir $tmpdir
30 or die "Cannot make temp dir $tmpdir: $!";
31
32# test file names shouldn't contain any shell special characters,
33# and for portability, probably shouldn't contain any high ascii or
34# Unicode characters
35#
36# handling Unicode here would be nice, but I think handling of Unicode
37# in perl's file system interfaces (open, unlink, readdir) etc needs to
38# be more regular before we can expect interoperability between find2perl
39# and a system find(1)
40#
41# keys for the test file list:
42# name - required
43# type - type of file to create:
44# "f" regular file, "d" directory, "l" link to target,
45# "s" symlink to target
46# atime, mtime - file times (default now)
47# mode - file mode (default per umask)
48# content - file content for type f files
49# target - target for link for type l and s
50#
51# I could have simply written code to create all the files, but I think
52# this makes the file tree a little more obvious
53use constant HOUR => 3600; # an hour in seconds
54my @test_files =
55 (
56 { name => "abc" },
57 { name => "acc", mtime => time() - HOUR * 48 },
58 { name => "ac", content => "x" x 10 },
59 { name => "somedir", type => "d" },
60 { name => "link", type => "l", target => "abc" },
61 { name => "symlink", type => "s", target => "brokenlink" },
62 );
63# make some files to search
64for my $spec (@test_files) {
65 my $file = File::Spec->catfile($tmpdir, split '/', $spec->{name});
66 my $type = $spec->{type} || "f";
67 if ($type eq "f") {
68 open my $fh, ">", $file
69 or die "Cannot create test file $file: $!";
70 if ($spec->{content}) {
71 binmode $fh;
72 print $fh $spec->{content};
73 }
74 close $fh
75 or die "Cannot close $file: $!";
76 }
77 elsif ($type eq "d") {
78 mkdir $file
79 or die "Cannot create test directory $file: $!";
80 }
81 elsif ($type eq "l") {
82 my $target = File::Spec->catfile($tmpdir, split '/', $spec->{target});
83 link $target, $file
84 or die "Cannot create test link $file: $!";
85 }
86 elsif ($type eq "s") {
87 my $target = File::Spec->catfile($tmpdir, split '/', $spec->{target});
88 symlink $target, $file
89 or die "Cannot create test symlink $file: $!";
90 }
91 if ($spec->{mode}) {
92 chmod $spec->{mode}, $file
93 or die "Cannot set mode of test file $file: $!";
94 }
95 if ($spec->{mtime} || $spec->{atime}) {
96 # default the times to now, since we just created the files
97 my $mtime = $spec->{mtime} || time();
98 my $atime = $spec->{atime} || time();
99 utime $atime, $mtime, $file
100 or die "Cannot set times of test file $file: $!";
101 }
102}
103
104# do we have a vaguely sane find(1)?
105my @files = sort `find '$tmpdir' -name 'abc' -o -name 'acc'`;
106@files == 2 && $files[0] =~ /\babc\n\z/ && $files[1] =~ /\bacc\n\z/
107 or skip_all("doesn't appear to be a sane find(1)");
108
109# required keys:
110# args - find search spec as an array ref
111# optional:
112# name - short description of the test (defaults to args)
113# expect - an array ref of files expected to be found (skips the find(1) call)
114# TODO - why this test is TODO (if it is), if a code reference that is
115# called to check if the test is TODO (and why)
116# SKIP - return a message for why to skip
117my @testcases =
118 (
119 {
120 name => "all files",
121 args => [],
122 },
123 {
124 name => "mapping of *",
125 args => [ "-name", "a*c" ],
126 },
127 {
128 args => [ "-type", "d" ],
129 expect => [ "", "somedir" ],
130 },
131 {
132 args => [ "-type", "f" ],
133 },
134 {
135 args => [ "-mtime", "+1" ],
136 expect => [ "acc" ],
137 },
138 {
139 args => [ "-mtime", "-1" ],
140 },
141 {
142 args => [ "-size", "10c" ],
143 expect => [ "ac" ],
144 },
145 {
146 args => [ "-links", "2" ],
147 expect => [ "abc", "link", "somedir" ],
148 },
149 {
150 name => "[perl #113054] mapping of ?",
151 args => [ "-name", "a?c" ],
bdbb33c8
TC
152 },
153 );
154
155my $find2perl = File::Spec->catfile(File::Spec->updir(), "x2p", "find2perl");
156our $TODO;
157plan(tests => scalar @testcases);
158for my $test (@testcases) {
159 SKIP:
160 {
161 local $TODO = $test->{TODO};
162 $TODO = $TODO->() if ref $TODO;
163 my $args = $test->{args}
164 or die "Missing test args";
165 my $name = $test->{name} || "@$args";
166
167 my $skip = $test->{SKIP} && $test->{SKIP}->();
168 $skip
169 and skip($skip, 1);
170
171 my $code = runperl(args => [ $find2perl, $tmpdir, @$args ]);
172
173 unless ($code) {
174 fail("$name: failed to run findperl");
175 next;
176 }
177
178 open my $script_fh, ">", $script
179 or die "Cannot create $script: $!";
180 print $script_fh $code;
181 close $script_fh
182 or die "Cannot close $script: $!";
183
184 my $files = runperl(progfile => $script);
185 my $find_files;
186 my $source;
187 if ($test->{expect}) {
188 $find_files = join "\n",
189 map { $_ eq "" ? $tmpdir : "$tmpdir/$_" }
190 @{$test->{expect}};
191 $source = "expected";
192 }
193 else {
194 my $findcmd = "find $tmpdir ". join " ", map "'$_'", @$args;
195
196 # make sure PERL_UNICODE doesn't reinterpret the output of find
197 use open IN => ':raw';
198 $find_files = `$findcmd`;
199 $source = "find";
200 }
201
202 # is the order from find (or find2perl) guaranteed?
203 # assume it isn't
204 $files = join("\n", sort split /\n/, $files);
205 $find_files = join("\n", sort split /\n/, $find_files);
206
207 if ($VERBOSE) {
208 note("script:\n$code");
209 note("args:\n@$args");
210 note("find2perl:\n$files");
211 note("find:\n$find_files");
212 }
213
214 is($files, $find_files, "$name: find2perl matches $source");
215 }
216}
217
218END {
219 remove_tree($tmpdir);
220}