]>
Commit | Line | Data |
---|---|---|
a8652edf TC |
1 | #!perl -w |
2 | use strict; | |
3 | use Test::More; | |
4 | use Imager; | |
5 | ||
6 | # this script tests an internal set of functions for Imager, they | |
7 | # aren't intended to be used at the perl level. | |
8 | # these functions aren't present in all Imager builds | |
9 | ||
10 | unless (Imager::Internal::Hlines::testing()) { | |
11 | plan skip_all => 'Imager not built to run this test'; | |
12 | } | |
13 | ||
14 | plan tests => 15; | |
15 | ||
16 | my $hline = Imager::Internal::Hlines::new(0, 100, 0, 100); | |
17 | my $base_text = 'start_y: 0 limit_y: 100 start_x: 0 limit_x: 100'; | |
18 | ok($hline, "made hline"); | |
19 | is($hline->dump, "$base_text\n", "check values"); | |
20 | $hline->add(5, -5, 7); | |
21 | is($hline->dump, <<EOS, "check (-5, 7) added"); | |
22 | $base_text | |
23 | 5 (1): [0, 2) | |
24 | EOS | |
25 | $hline->add(5, 8, 4); | |
26 | is($hline->dump, <<EOS, "check (8, 4) added"); | |
27 | $base_text | |
28 | 5 (2): [0, 2) [8, 12) | |
29 | EOS | |
30 | $hline->add(5, 3, 3); | |
31 | is($hline->dump, <<EOS, "check (3, 3) added"); | |
32 | $base_text | |
33 | 5 (3): [0, 2) [3, 6) [8, 12) | |
34 | EOS | |
35 | $hline->add(5, 2, 6); | |
36 | is($hline->dump, <<EOS, "check (2, 6) added"); | |
37 | $base_text | |
38 | 5 (1): [0, 12) | |
39 | EOS | |
40 | # adding out of range should do nothing | |
41 | my $current = <<EOS; | |
42 | $base_text | |
43 | 5 (1): [0, 12) | |
44 | EOS | |
45 | $hline->add(6, -5, 5); | |
46 | is($hline->dump, $current, "check (6, -5, 5) not added"); | |
47 | $hline->add(6, 100, 5); | |
48 | is($hline->dump, $current, "check (6, 100, 5) not added"); | |
49 | $hline->add(-1, 5, 2); | |
50 | is($hline->dump, $current, "check (-1, 5, 2) not added"); | |
51 | $hline->add(100, 5, 2); | |
52 | is($hline->dump, $current, "check (10, 5, 2) not added"); | |
53 | ||
54 | # overlapped add check | |
55 | $hline->add(6, 2, 6); | |
56 | $hline->add(6, 3, 4); | |
57 | is($hline->dump, <<EOS, "check internal overlap merged"); | |
58 | $base_text | |
59 | 5 (1): [0, 12) | |
60 | 6 (1): [2, 8) | |
61 | EOS | |
62 | ||
63 | # white box test: try to force reallocation of an entry | |
64 | for my $i (0..20) { | |
65 | $hline->add(7, $i*2, 1); | |
66 | } | |
67 | is($hline->dump, <<EOS, "lots of segments"); | |
68 | $base_text | |
69 | 5 (1): [0, 12) | |
70 | 6 (1): [2, 8) | |
71 | 7 (21): [0, 1) [2, 3) [4, 5) [6, 7) [8, 9) [10, 11) [12, 13) [14, 15) [16, 17) [18, 19) [20, 21) [22, 23) [24, 25) [26, 27) [28, 29) [30, 31) [32, 33) [34, 35) [36, 37) [38, 39) [40, 41) | |
72 | EOS | |
73 | # now merge them | |
74 | $hline->add(7, 1, 39); | |
75 | is($hline->dump, <<EOS, "merge lots of segments"); | |
76 | $base_text | |
77 | 5 (1): [0, 12) | |
78 | 6 (1): [2, 8) | |
79 | 7 (1): [0, 41) | |
80 | EOS | |
81 | ||
82 | # clean object | |
83 | $hline = Imager::Internal::Hlines::new(50, 50, 50, 50); | |
84 | $base_text = 'start_y: 50 limit_y: 100 start_x: 50 limit_x: 100'; | |
85 | ||
86 | # left merge | |
87 | $hline->add(51, 45, 10); | |
88 | $hline->add(51, 55, 4); | |
89 | is($hline->dump, <<EOS, "left merge"); | |
90 | $base_text | |
91 | 51 (1): [50, 59) | |
92 | EOS | |
93 | ||
94 | # right merge | |
95 | $hline->add(52, 90, 5); | |
96 | $hline->add(52, 87, 5); | |
97 | is($hline->dump, <<EOS, "right merge"); | |
98 | $base_text | |
99 | 51 (1): [50, 59) | |
100 | 52 (1): [87, 95) | |
101 | EOS | |
102 | ||
103 | undef $hline; |