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