t/900-util/060-hlines.t

   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;