This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #113054] find2perl mistranslates fileglob ? to regex .?
[perl5.git] / t / x2p / find2perl.t
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
8 BEGIN {
9     chdir 't' if -d 't';
10     @INC = ( '../lib' );
11 }
12
13 use strict;
14 use warnings;
15 use File::Path 'remove_tree';
16 use File::Spec;
17 require "./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
25 my $VERBOSE = grep $_ eq '-v', @ARGV;
26
27 my $tmpdir = tempfile();
28 my $script = tempfile();
29 mkdir $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
53 use constant HOUR => 3600; # an hour in seconds
54 my @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
64 for 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)?
105 my @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
117 my @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" ],
152         },
153     );
154
155 my $find2perl = File::Spec->catfile(File::Spec->updir(), "x2p", "find2perl");
156 our $TODO;
157 plan(tests => scalar @testcases);
158 for 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
218 END {
219     remove_tree($tmpdir);
220 }