bench/gifthread.pl

   1 #!perl -w
   2 use strict;
   3 use threads;
   4 use Imager;
   5
   6 ++$|;
   7 Imager->preload;
   8
   9 # as a TIFF this file is large, build it from largeish.jpg if it
  10 # doesn't exist
  11 unless (-f "bench/largish.gif") {
  12   my $im = Imager->new(file => "bench/largish.jpg")
  13     or die "Cannot read bench/largish.jpg:", Imager->errstr;
  14   $im->write(file => "bench/largish.gif")
  15     or die "Cannot write bench/largish.gif:", $im->errstr;
  16 }
  17
  18 my @tests =
  19   (
  20    [ "bench/largish.gif", "" ],
  21    [ "GIF/testimg/scale.gif", "" ],
  22    [ "GIF/testimg/nocmap.gif", "Image does not have a local or a global color map" ],
  23   );
  24
  25 my @threads;
  26 my $name = "A";
  27 for my $test (@tests) {
  28   push @threads,
  29     threads->create
  30       (
  31        sub  {
  32          my ($file, $result, $name) = @_;
  33          for (1 .. 100000) {
  34            print $name;
  35            my $im = Imager->new(file => $file);
  36            if ($result) {
  37              $im and die "Expected error from $file, got image";
  38              Imager->errstr eq $result
  39                or die "Expected error '$result', got '",Imager->errstr, "'"
  40            }
  41            else {
  42              $im or die "Expected image got error '", Imager->errstr, "'";
  43            }
  44          }
  45          return;
  46        },
  47        @$test,
  48        $name
  49       );
  50   ++$name;
  51 }
  52
  53 for my $t (@threads) {
  54   $t->join();
  55 }