t/t65crop.t

   1 #!perl -w
   2 use strict;
   3 use lib 't';
   4 use Test::More tests => 60;
   5 require "t/testtools.pl";
   6 use Imager;
   7
   8 #$Imager::DEBUG=1;
   9
  10 Imager::init('log'=>'testout/t65crop.log');
  11
  12 my $img=Imager->new() || die "unable to create image object\n";
  13
  14 ok($img, "created image ph");
  15
  16 SKIP:
  17 {
  18   skip("couldn't load source image", 2)
  19     unless ok($img->open(file=>'testimg/scale.ppm',type=>'pnm'), "loaded source");
  20   my $nimg = $img->crop(top=>10, left=>10, bottom=>25, right=>25);
  21   ok($nimg, "got an image");
  22   ok($nimg->write(file=>"testout/t65.ppm"), "save to file");
  23 }
  24
  25 { # https://rt.cpan.org/Ticket/Display.html?id=7578
  26   # make sure we get the right type of image on crop
  27   my $src = Imager->new(xsize=>50, ysize=>50, channels=>2, bits=>16);
  28   is($src->getchannels, 2, "check src channels");
  29   is($src->bits, 16, "check src bits");
  30   my $out = $src->crop(left=>10, right=>40, top=>10, bottom=>40);
  31   is($out->getchannels, 2, "check out channels");
  32   is($out->bits, 16, "check out bits");
  33 }
  34 { # https://rt.cpan.org/Ticket/Display.html?id=7578
  35   print "# try it for paletted too\n";
  36   my $src = Imager->new(xsize=>50, ysize=>50, channels=>3, type=>'paletted');
  37   # make sure color index zero is defined so there's something to copy
  38   $src->addcolors(colors=>[Imager::Color->new(0,0,0)]);
  39   is($src->type, 'paletted', "check source type");
  40   my $out = $src->crop(left=>10, right=>40, top=>10, bottom=>40);
  41   is($out->type, 'paletted', 'check output type');
  42 }
  43
  44 { # https://rt.cpan.org/Ticket/Display.html?id=7581
  45   # crop() documentation says width/height takes precedence, but is unclear
  46   # from looking at the existing code, setting width/height will go from
  47   # the left of the image, even if left/top are provided, despite the
  48   # sample in the docs
  49   # Let's make sure that things happen as documented
  50   my $src = test_oo_img();
  51   # make sure we get what we want
  52   is($src->getwidth, 150, "src width");
  53   is($src->getheight, 150, "src height");
  54
  55   # the test data is:
  56   #  - description
  57   #  - hash ref containing args to crop()
  58   #  - expected left, top, right, bottom values
  59   # we call crop using the given arguments then call it using the
  60   # hopefully stable left/top/right/bottom/arguments
  61   # this is kind of lame, but I don't want to include a rewritten
  62   # crop in this file
  63   my @tests =
  64     (
  65      [
  66       "basic",
  67       { left=>10, top=>10, right=>70, bottom=>80 },
  68       10, 10, 70, 80,
  69      ],
  70      [
  71       "middle",
  72       { width=>50, height=>50 },
  73       50, 50, 100, 100,
  74      ],
  75      [
  76       "lefttop",
  77       { left=>20, width=>70, top=>30, height=>90 },
  78       20, 30, 90, 120,
  79      ],
  80      [
  81       "bottomright",
  82       { right=>140, width=>50, bottom=>130, height=>60 },
  83       90, 70, 140, 130,
  84      ],
  85      [
  86       "acrossmiddle",
  87       { top=>40, bottom=>110 },
  88       0, 40, 150, 110,
  89      ],
  90      [
  91       "downmiddle",
  92       { left=>40, right=>110 },
  93       40, 0, 110, 150,
  94      ],
  95      [
  96       "rightside",
  97       { left=>80, },
  98       80, 0, 150, 150,
  99      ],
 100      [
 101       "leftside",
 102       { right=>40 },
 103       0, 0, 40, 150,
 104      ],
 105      [
 106       "topside",
 107       { bottom=>40, },
 108       0, 0, 150, 40,
 109      ],
 110      [
 111       "bottomside",
 112       { top=>90 },
 113       0, 90, 150, 150,
 114      ],
 115      [
 116       "overright",
 117       { left=>100, right=>200 },
 118       100, 0, 150, 150,
 119      ],
 120      [
 121       "overtop",
 122       { bottom=>50, height=>70 },
 123       0, 0, 150, 50,
 124      ],
 125      [
 126       "overleft",
 127       { right=>30, width=>60 },
 128       0, 0, 30, 150,
 129      ],
 130      [
 131       "overbottom",
 132       { top=>120, height=>60 },
 133       0, 120, 150, 150,
 134      ],
 135     );
 136   for my $test (@tests) {
 137     my ($desc, $args, $left, $top, $right, $bottom) = @$test;
 138     my $out = $src->crop(%$args);
 139     ok($out, "got output for $desc");
 140     my $cmp = $src->crop(left=>$left, top=>$top, right=>$right, bottom=>$bottom);
 141     ok($cmp, "got cmp for $desc");
 142     # make sure they're the same
 143     my $diff = Imager::i_img_diff($out->{IMG}, $cmp->{IMG});
 144     is($diff, 0, "difference should be 0 for $desc");
 145   }
 146 }
 147 { # https://rt.cpan.org/Ticket/Display.html?id=7581
 148   # previously we didn't check that the result had some pixels
 149   # make sure we do
 150   my $src = test_oo_img();
 151   ok(!$src->crop(left=>50, right=>50), "nothing across");
 152   cmp_ok($src->errstr, '=~', qr/resulting image would have no content/,
 153          "and message");
 154   ok(!$src->crop(top=>60, bottom=>60), "nothing down");
 155   cmp_ok($src->errstr, '=~', qr/resulting image would have no content/,
 156          "and message");
 157 }
 158
 159 { # http://rt.cpan.org/NoAuth/Bug.html?id=9672
 160   my $warning;
 161   local $SIG{__WARN__} =
 162     sub {
 163       $warning = "@_";
 164       my $printed = $warning;
 165       $printed =~ s/\n$//;
 166       $printed =~ s/\n/\n\#/g;
 167       print "# ",$printed, "\n";
 168     };
 169   my $img = Imager->new(xsize=>10, ysize=>10);
 170   $img->crop(left=>5);
 171   cmp_ok($warning, '=~', 'void', "correct warning");
 172   cmp_ok($warning, '=~', 't65crop\\.t', "correct file");
 173 }