]> git.imager.perl.org - imager.git/blob - bench/tifthread.pl
RT #117878: handle invalid image objects for write_multi()
[imager.git] / bench / tifthread.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.tif") {
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.tif")
15     or die "Cannot write bench.largish.tif:", $im->errstr;
16 }
17
18 my @tests =
19   (
20    [ "bench/largish.tif", "" ],
21    [ "TIFF/testimg/grey16.tif", "" ],
22    [ "TIFF/testimg/comp4bad.tif", "(Iolayer): Read error at scanline 120; got 0 bytes, expected 32" ],
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 }