Extra ways of calling translate(), shear()
[imager.git] / fuzz / fuzz.pl
CommitLineData
19f89942
TC
1#!perl -w
2use blib;
3use strict;
4use Imager;
5use Getopt::Long;
6
7my $count = 1000;
8GetOptions("c=i"=>\$count)
9 or usage();
10
11my @files = @ARGV;
12unless (@files) {
13 @files = glob('testimg/*.gif'), glob('testout/*');
14}
15
16@files = grep -f, @files;
17Imager->set_file_limits(bytes => 20_000_000);
18++$|;
19for my $i (1 .. $count) {
20 my $filename = $files[rand @files];
21 open FILE, "< $filename" or die "Cannot read $filename: $!\n";
22 binmode FILE;
23 my $data = do { local $/; <FILE> };
24 close FILE;
25
26 print ">> $filename - length ", length $data, "\n";
27 if (rand() < 0.2) {
28 # random truncation
29 my $new_length = int(1 + rand(length($data)-2));
30 substr($data, $new_length) = '';
31 print " trunc($new_length)\n";
32 }
33 # random damage
34 for (0..int(rand 5)) {
35 my $offset = int(rand(length($data)));
36 my $len = int(1+rand(5));
37 if ($offset + $len > length $data) {
38 $len = length($data) - $offset;
39 }
40 my $ins = join '', map chr(rand(256)), 1..$len;
41 print " replace $offset/$len: ", unpack("H*", $ins), "\n";
42 substr($data, $offset, $len, $ins);
43 }
44 my $im = Imager->new;
45 if ($im->read(data => $data)) {
46 print "<< Success\n";
47 }
48 else {
49 print "<< Failure: ", $im->errstr, "\n";
50 }
51}
52
53sub usage {
54 print <<EOS;
55perl $0 [-c count] [files]
56EOS
57 exit;
58}