Commit | Line | Data |
---|---|---|
536b7775 TC |
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 | } |