fuzz testing

diff --git a/fuzz/fuzz.pl b/fuzz/fuzz.pl
new file mode 100644 (file)
index 0000000..8503229
--- /dev/null
+++ b/fuzz/fuzz.pl
@@ -0,0 +1,58 @@
+#!perl -w
+use blib;
+use strict;
+use Imager;
+use Getopt::Long;
+
+my $count = 1000;
+GetOptions("c=i"=>\$count)
+  or usage();
+
+my @files = @ARGV;
+unless (@files) {
+  @files = glob('testimg/*.gif'), glob('testout/*');
+}
+
+@files = grep -f, @files;
+Imager->set_file_limits(bytes => 20_000_000);
+++$|;
+for my $i (1 .. $count) {
+  my $filename = $files[rand @files];
+  open FILE, "< $filename" or die "Cannot read $filename: $!\n";
+  binmode FILE;
+  my $data = do { local $/; <FILE> };
+  close FILE;
+
+  print ">> $filename - length ", length $data, "\n";
+  if (rand() < 0.2) {
+    # random truncation
+    my $new_length = int(1 + rand(length($data)-2));
+    substr($data, $new_length) = '';
+    print "  trunc($new_length)\n";
+  }
+  # random damage
+  for (0..int(rand 5)) {
+    my $offset = int(rand(length($data)));
+    my $len = int(1+rand(5));
+    if ($offset + $len > length $data) {
+      $len = length($data) - $offset;
+    }
+    my $ins = join '', map chr(rand(256)), 1..$len;
+    print "  replace $offset/$len: ", unpack("H*", $ins), "\n";
+    substr($data, $offset, $len, $ins);
+  }
+  my $im = Imager->new;
+  if ($im->read(data => $data)) {
+    print "<< Success\n";
+  }
+  else {
+    print "<< Failure: ", $im->errstr, "\n";
+  }
+}
+
+sub usage {
+  print <<EOS;
+perl $0 [-c count] [files]
+EOS
+  exit;
+}