handle failure to clone the log filehandle when cloning the Imager context
[imager.git] / fuzz / fuzz.pl
CommitLineData
19f89942
TC
1#!perl -w
2use blib;
3use strict;
4use Imager;
5use Getopt::Long;
9b1ec2b8 6use Time::HiRes qw(time);
19f89942
TC
7
8my $count = 1000;
9GetOptions("c=i"=>\$count)
10 or usage();
11
12my @files = @ARGV;
13unless (@files) {
14 @files = glob('testimg/*.gif'), glob('testout/*');
15}
16
17@files = grep -f, @files;
18Imager->set_file_limits(bytes => 20_000_000);
19++$|;
20for 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 }
9b1ec2b8 45 my $start = time;
19f89942 46 my $im = Imager->new;
9b1ec2b8
TC
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) {
19f89942
TC
54 print "<< Success\n";
55 }
56 else {
57 print "<< Failure: ", $im->errstr, "\n";
58 }
59}
60
61sub usage {
62 print <<EOS;
63perl $0 [-c count] [files]
64EOS
65 exit;
66}