Commit | Line | Data |
---|---|---|
f46b1894 TC |
1 | #!perl -w |
2 | use strict; | |
3 | use Imager; | |
4 | use Imager::Color::Float; | |
5 | use Imager::Fill; | |
6 | use Config; | |
7 | my $loaded_threads; | |
8 | BEGIN { | |
9 | if ($Config{useithreads} && $] > 5.008007) { | |
10 | $loaded_threads = | |
11 | eval { | |
12 | require threads; | |
13 | threads->import; | |
14 | 1; | |
15 | }; | |
16 | } | |
17 | } | |
18 | use Test::More; | |
19 | ||
20 | $Config{useithreads} | |
21 | or plan skip_all => "can't test Imager's threads support with no threads"; | |
22 | $] > 5.008007 | |
23 | or plan skip_all => "require a perl with CLONE_SKIP to test Imager's threads support"; | |
24 | $loaded_threads | |
25 | or plan skip_all => "couldn't load threads"; | |
26 | ||
27 | $INC{"Devel/Cover.pm"} | |
28 | and plan skip_all => "threads and Devel::Cover don't get along"; | |
29 | ||
30 | # https://rt.cpan.org/Ticket/Display.html?id=65812 | |
31 | # https://github.com/schwern/test-more/issues/labels/Test-Builder2#issue/100 | |
32 | $Test::More::VERSION =~ /^2\.00_/ | |
33 | and plan skip_all => "threads are hosed in 2.00_06 and presumably all 2.00_*"; | |
34 | ||
35 | plan tests => 1; | |
36 | ||
37 | Imager->preload; | |
38 | ||
39 | ++$|; | |
40 | ||
41 | { | |
42 | my @t; | |
43 | for (1 .. 10) { | |
44 | push @t, threads->create | |
45 | ( | |
46 | sub { | |
47 | my ($which) = @_; | |
48 | my @im; | |
49 | print "# start $which\n"; | |
50 | for (1 .. 1000) { | |
51 | push @im, Imager->new(xsize => 10, ysize => 10); | |
52 | $im[0]->box(fill => { solid => "#FF0000" }); | |
53 | my $im = Imager->new(xsize => 10, ysize => 10, type => "paletted"); | |
54 | $im->setpixel(x => 5, y => 5, color => "#808080"); | |
55 | } | |
56 | print "# end $which\n"; | |
57 | }, | |
58 | $_ | |
59 | ); | |
60 | } | |
61 | $_->join for @t; | |
62 | pass("grind image creation"); | |
63 | } |