t/t65crop.t

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