- previously, if you supplied to_paletted and empty color map
authorTony Cook <tony@develop=help.com>
Sun, 5 Sep 2004 05:28:46 +0000 (05:28 +0000)
committerTony Cook <tony@develop=help.com>
Sun, 5 Sep 2004 05:28:46 +0000 (05:28 +0000)
          and set make_colors to 'none', quant_translate() would segfault.
          This was because it was making the reasonable assumption that
          you'd have colors to map to.  quant_translate() now checks there
          is at least one color and return NULL if there isn't.
        - i_img_to_pal() now does error checking of the value returned by
          quant_translate().
        - Imager::to_paletted() now checks for success/failure of
          i_img_to_pal() correctly and does appropriate error handling.
        - i_writegif_low() did no error checking on the result of
          quant_translate(), it now does
        - we now test that trying to write a GIF image with no palette
          allowable by the quant options is a failure.
        - Imager::write() was doing nothing with the result of the call
          to i_writegif_gen(), in particular it wasn't returning () on
          failure.
        - added tests for paletted image handling and the methods
          specific to those images
        - the XS for i_setcolors() was missing the OUTPUT clause for
          RETVAL, and hence wasn't returning failure on failure.
        - supplying a sufficiently small scaling value could make the
          scale() method return an image with zero height or width.
        - the void context warning for scale() now includes the callers
          filename/line (instead of the default of Imager.pm line 15xx)
        - Imager->new will now return undef if the dimensions or number of
          channels specified for an image are out of range.  An error
          message can be retrieved with Imager->errstr.

18 files changed:
Changes
Imager.pm
Imager.xs
MANIFEST
gif.c
image.c
img16.c
imgdouble.c
lib/Imager/ImageTypes.pod
palimg.c
quant.c
t/t01introvert.t
t/t021sixteen.t
t/t022double.t
t/t023palette.t [new file with mode: 0644]
t/t105gif.t
t/t40scale.t
t/testtools.pl

diff --git a/Changes b/Changes
index 3879ee0..368c95c 100644 (file)
--- a/Changes
+++ b/Changes
@@ -783,6 +783,33 @@ Revision history for Perl extension Imager.
           Thanks to Elthek on rhizo for reporting this and help in 
           tracking it down.
         - added a bunch of tests for reading pnm files.
+        - previously, if you supplied to_paletted and empty color map
+          and set make_colors to 'none', quant_translate() would segfault.
+          This was because it was making the reasonable assumption that
+          you'd have colors to map to.  quant_translate() now checks there
+          is at least one color and return NULL if there isn't.
+        - i_img_to_pal() now does error checking of the value returned by
+          quant_translate().
+        - Imager::to_paletted() now checks for success/failure of 
+          i_img_to_pal() correctly and does appropriate error handling.
+        - i_writegif_low() did no error checking on the result of
+          quant_translate(), it now does
+        - we now test that trying to write a GIF image with no palette
+          allowable by the quant options is a failure.
+        - Imager::write() was doing nothing with the result of the call 
+          to i_writegif_gen(), in particular it wasn't returning () on 
+          failure.
+        - added tests for paletted image handling and the methods
+          specific to those images
+        - the XS for i_setcolors() was missing the OUTPUT clause for
+          RETVAL, and hence wasn't returning failure on failure.
+        - supplying a sufficiently small scaling value could make the
+          scale() method return an image with zero height or width.
+        - the void context warning for scale() now includes the callers
+          filename/line (instead of the default of Imager.pm line 15xx)
+        - Imager->new will now return undef if the dimensions or number of
+          channels specified for an image are out of range.  An error
+          message can be retrieved with Imager->errstr.
 
 =================================================================
 
index f5930f8..7dca158 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -526,7 +526,12 @@ sub new {
   $self->{ERRSTR}=undef; #
   $self->{DEBUG}=$DEBUG;
   $self->{DEBUG} && print "Initialized Imager\n";
-  if ($hsh{xsize} && $hsh{ysize}) { $self->img_set(%hsh); }
+  if (defined $hsh{xsize} && defined $hsh{ysize}) { 
+    unless ($self->img_set(%hsh)) {
+      $Imager::ERRSTR = $self->{ERRSTR};
+      return;
+    }
+  }
   return $self;
 }
 
@@ -637,6 +642,13 @@ sub img_set {
     $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'}, $hsh{'ysize'},
                                      $hsh{'channels'});
   }
+
+  unless ($self->{IMG}) {
+    $self->{ERRSTR} = Imager->_error_as_msg();
+    return;
+  }
+
+  $self;
 }
 
 # created a masked version of the current image
@@ -678,9 +690,13 @@ sub to_paletted {
 
   #print "Type ", i_img_type($result->{IMG}), "\n";
 
-  $result->{IMG} or undef $result;
-
-  return $result;
+  if ($result->{IMG}) {
+    return $result;
+  }
+  else {
+    $self->{ERRSTR} = $self->_error_as_msg;
+    return;
+  }
 }
 
 # convert a paletted (or any image) to an 8-bit/channel RGB images
@@ -1335,7 +1351,10 @@ sub write {
       $input{make_colors} = 'webmap'; # ignored
       $input{translate} = 'giflib';
     }
-    $rc = i_writegif_wiol($IO, \%input, $self->{IMG});
+    if (!i_writegif_wiol($IO, \%input, $self->{IMG})) {
+      $self->{ERRSTR} = $self->_error_as_msg;
+      return;
+    }
   }
 
   if (exists $input{'data'}) {
@@ -1523,7 +1542,8 @@ sub scale {
   my $tmp = Imager->new();
 
   unless (defined wantarray) {
-    warn "scale() called in void context - scale() returns the scaled image";
+    my @caller = caller;
+    warn "scale() called in void context - scale() returns the scaled image at $caller[1] line $caller[2]\n";
     return;
   }
 
index 3919aaa..f61b92b 100644 (file)
--- a/Imager.xs
+++ b/Imager.xs
@@ -3433,7 +3433,7 @@ i_addcolors(im, ...)
           ST(0) = sv_2mortal(newSViv(index));
         }
 
-int 
+undef_int 
 i_setcolors(im, index, ...)
         Imager::ImgRaw  im
         int index
@@ -3457,6 +3457,8 @@ i_setcolors(im, index, ...)
         }
         RETVAL = i_setcolors(im, index, colors, items-2);
         myfree(colors);
+      OUTPUT:
+       RETVAL
 
 void
 i_getcolors(im, index, ...)
index 15774a8..97e146c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -90,6 +90,7 @@ t/t01introvert.t
 t/t020masked.t
 t/t021sixteen.t
 t/t022double.t          Test double/sample images
+t/t023palette.t                Test paletted images
 t/t05error.t
 t/t07iolayer.t
 t/t101jpeg.t
@@ -138,7 +139,7 @@ testimg/expected.gif
 testimg/gimpgrad        A GIMP gradient file
 testimg/junk.ppm
 testimg/loccmap.gif
-testimg/maxval.ppm
+testimg/maxval.ppm     For ppm file maxval handling
 testimg/maxval_0.ppm
 testimg/maxval_256.ppm
 testimg/maxval_4095_asc.ppm
diff --git a/gif.c b/gif.c
index f22d5e1..9f3f397 100644 (file)
--- a/gif.c
+++ b/gif.c
@@ -1678,6 +1678,12 @@ i_writegif_low(i_quantize *quant, GifFileType *gf, i_img **imgs, int count) {
     result = quant_paletted(quant, imgs[0]);
   else
     result = quant_translate(quant, imgs[0]);
+  if (!result) {
+    i_mempool_destroy(&mp);
+    quant->mc_colors = orig_colors;
+    EGifCloseFile(gf);
+    return 0;
+  }
   if (want_trans) {
     quant_transparent(quant, result, imgs[0], quant->mc_count);
     trans_index = quant->mc_count;
@@ -1753,6 +1759,13 @@ i_writegif_low(i_quantize *quant, GifFileType *gf, i_img **imgs, int count) {
         quant_makemap(quant, imgs+imgn, 1);
         result = quant_translate(quant, imgs[imgn]);
       }
+      if (!result) {
+        i_mempool_destroy(&mp);
+        quant->mc_colors = orig_colors;
+        EGifCloseFile(gf);
+        mm_log((1, "error in quant_translate()"));
+        return 0;
+      }
       if (want_trans) {
         quant_transparent(quant, result, imgs[imgn], quant->mc_count);
         trans_index = quant->mc_count;
diff --git a/image.c b/image.c
index a89ccb8..86aa3f6 100644 (file)
--- a/image.c
+++ b/image.c
@@ -350,6 +350,16 @@ Re-new image reference
 i_img *
 i_img_empty_ch(i_img *im,int x,int y,int ch) {
   mm_log((1,"i_img_empty_ch(*im %p, x %d, y %d, ch %d)\n", im, x, y, ch));
+
+  if (x < 1 || y < 1) {
+    i_push_error(0, "Image sizes must be positive");
+    return NULL;
+  }
+  if (ch < 1 || ch > MAXCHANNELS) {
+    i_push_errorf(0, "channels must be between 1 and %d", MAXCHANNELS);
+    return NULL;
+  }
+
   if (im == NULL)
     if ( (im=mymalloc(sizeof(i_img))) == NULL)
       m_fatal(2,"malloc() error\n");
@@ -896,6 +906,10 @@ i_scaleaxis(i_img *im, float Value, int Axis) {
 
   if (Axis == XAXIS) {
     hsize = (int)(0.5 + im->xsize * Value);
+    if (hsize < 1) {
+      hsize = 1;
+      Value = 1 / im->xsize;
+    }
     vsize = im->ysize;
     
     jEnd = hsize;
@@ -904,6 +918,11 @@ i_scaleaxis(i_img *im, float Value, int Axis) {
     hsize = im->xsize;
     vsize = (int)(0.5 + im->ysize * Value);
 
+    if (vsize < 1) {
+      vsize = 1;
+      Value = 1 / im->ysize;
+    }
+
     jEnd = vsize;
     iEnd = hsize;
   }
@@ -1021,7 +1040,15 @@ i_scale_nn(i_img *im, float scx, float scy) {
   mm_log((1,"i_scale_nn(im 0x%x,scx %.2f,scy %.2f)\n",im,scx,scy));
 
   nxsize = (int) ((float) im->xsize * scx);
+  if (nxsize < 1) {
+    nxsize = 1;
+    scx = 1 / im->xsize;
+  }
   nysize = (int) ((float) im->ysize * scy);
+  if (nysize < 1) {
+    nysize = 1;
+    scy = 1 / im->ysize;
+  }
     
   new_img=i_img_empty_ch(NULL,nxsize,nysize,im->channels);
   
diff --git a/img16.c b/img16.c
index 63df6f9..bb58475 100644 (file)
--- a/img16.c
+++ b/img16.c
@@ -144,6 +144,15 @@ Creates a new 16-bit per sample image.
 */
 i_img *i_img_16_new_low(i_img *im, int x, int y, int ch) {
   mm_log((1,"i_img_16_new(x %d, y %d, ch %d)\n", x, y, ch));
+
+  if (x < 1 || y < 1) {
+    i_push_error(0, "Image sizes must be positive");
+    return NULL;
+  }
+  if (ch < 1 || ch > MAXCHANNELS) {
+    i_push_errorf(0, "channels must be between 1 and %d", MAXCHANNELS);
+    return NULL;
+  }
   
   *im = IIM_base_16bit_direct;
   i_tags_new(&im->tags);
@@ -166,6 +175,8 @@ i_img *i_img_16_new_low(i_img *im, int x, int y, int ch) {
 
 i_img *i_img_16_new(int x, int y, int ch) {
   i_img *im;
+  
+  i_clear_error();
 
   im = mymalloc(sizeof(i_img));
   if (im) {
index 9058782..d8e852f 100644 (file)
@@ -87,6 +87,15 @@ Creates a new double per sample image.
 */
 i_img *i_img_double_new_low(i_img *im, int x, int y, int ch) {
   mm_log((1,"i_img_double_new(x %d, y %d, ch %d)\n", x, y, ch));
+
+  if (x < 1 || y < 1) {
+    i_push_error(0, "Image sizes must be positive");
+    return NULL;
+  }
+  if (ch < 1 || ch > MAXCHANNELS) {
+    i_push_errorf(0, "channels must be between 1 and %d", MAXCHANNELS);
+    return NULL;
+  }
   
   *im = IIM_base_double_direct;
   i_tags_new(&im->tags);
@@ -110,6 +119,8 @@ i_img *i_img_double_new_low(i_img *im, int x, int y, int ch) {
 i_img *i_img_double_new(int x, int y, int ch) {
   i_img *im;
 
+  i_clear_error();
+
   im = mymalloc(sizeof(i_img));
   if (im) {
     if (!i_img_double_new_low(im, x, y, ch)) {
index 001b200..8f4d7f4 100644 (file)
@@ -270,7 +270,7 @@ adding the colors would overflow the palette.
   $img->setcolors(start=>$start, colors=>\@colors);
 
 Once you have colors in the palette you can overwrite them with the
-C<setcolors()> method:  C<sercolors()> returns true on success.
+C<setcolors()> method:  C<setcolors()> returns true on success.
 
 =item getcolors
 
index 4fb43c8..f397807 100644 (file)
--- a/palimg.c
+++ b/palimg.c
@@ -95,7 +95,7 @@ i_img *i_img_pal_new_low(i_img *im, int x, int y, int channels, int maxpal) {
     return NULL;
   }
   if (channels < 1 || channels > MAXCHANNELS) {
-    i_push_errorf(0, "Channels must be postive and <= %d", MAXCHANNELS);
+    i_push_errorf(0, "Channels must be positive and <= %d", MAXCHANNELS);
     return NULL;
   }
 
@@ -189,20 +189,28 @@ Converts an RGB image to a paletted image
 i_img *i_img_to_pal(i_img *src, i_quantize *quant) {
   i_palidx *result;
   i_img *im;
-  
-  im = i_img_pal_new(src->xsize, src->ysize, src->channels, quant->mc_size);
 
+  i_clear_error();
+  
   quant_makemap(quant, &src, 1);
   result = quant_translate(quant, src);
 
-  /* copy things over */
-  memcpy(im->idata, result, im->bytes);
-  PALEXT(im)->count = quant->mc_count;
-  memcpy(PALEXT(im)->pal, quant->mc_colors, sizeof(i_color) * quant->mc_count);
+  if (result) {
 
-  myfree(result);
+    im = i_img_pal_new(src->xsize, src->ysize, src->channels, quant->mc_size);
 
-  return im;
+    /* copy things over */
+    memcpy(im->idata, result, im->bytes);
+    PALEXT(im)->count = quant->mc_count;
+    memcpy(PALEXT(im)->pal, quant->mc_colors, sizeof(i_color) * quant->mc_count);
+    
+    myfree(result);
+
+    return im;
+  }
+  else {
+    return NULL;
+  }
 }
 
 /*
diff --git a/quant.c b/quant.c
index 9c22edf..1f7e9c9 100644 (file)
--- a/quant.c
+++ b/quant.c
@@ -81,6 +81,13 @@ i_palidx *quant_translate(i_quantize *quant, i_img *img) {
   i_palidx *result;
   mm_log((1, "quant_translate(quant %p, img %p)\n", quant, img));
 
+  /* there must be at least one color in the paletted (though even that
+     isn't very useful */
+  if (quant->mc_count == 0) {
+    i_push_error(0, "no colors available for translation");
+    return NULL;
+  }
+
   result = mymalloc(img->xsize * img->ysize);
 
   switch (quant->translate) {
@@ -671,7 +678,6 @@ makemap_mediancut(i_quantize *quant, i_img **imgs, int count) {
       if (imgs[imgn]->channels > 2) {
         chan_count = 3;
         for (x = 0; x < imgs[imgn]->xsize; ++x) {
-         printf("bumped entry %d\n", MED_CUT_INDEX(line[x]));
           ++colors[MED_CUT_INDEX(line[x])].count;
         }
       }
index c1c725d..8e9c29f 100644 (file)
@@ -8,12 +8,14 @@
 use strict;
 
 my $loaded;
-BEGIN { $| = 1; print "1..71\n"; }
+BEGIN { $| = 1; print "1..85\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Imager qw(:handy :all);
 $loaded = 1;
 print "ok 1\n";
 
+require "t/testtools.pl";
+
 init_log("testout/t01introvert.log",1);
 
 my $im_g = Imager::ImgRaw::new(100, 101, 1);
@@ -222,6 +224,33 @@ print "ok 56\n";
   print "ok 71\n";
 }
 
+my $num = 72;
+okn($num++, !Imager->new(xsize=>0, ysize=>1), "fail to create 0 height image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "0 height error message check");
+okn($num++, !Imager->new(xsize=>1, ysize=>0), "fail to create 0 width image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "0 width error message check");
+okn($num++, !Imager->new(xsize=>-1, ysize=>1), "fail to create -ve height image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "-ve width error message check");
+okn($num++, !Imager->new(xsize=>1, ysize=>-1), "fail to create -ve width image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "-ve height error message check");
+okn($num++, !Imager->new(xsize=>-1, ysize=>-1), "fail to create -ve width/height image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "-ve width/height error message check");
+
+okn($num++, !Imager->new(xsize=>1, ysize=>1, channels=>0),
+    "fail to create a zero channel image");
+matchn($num++, Imager->errstr, qr/channels must be between 1 and 4/,
+       "out of range channel message check");
+okn($num++, !Imager->new(xsize=>1, ysize=>1, channels=>5),
+    "fail to create a five channel image");
+matchn($num++, Imager->errstr, qr/channels must be between 1 and 4/,
+       "out of range channel message check");
+
+
 sub check_add {
   my ($base, $im, $color, $expected) = @_;
   my $index = Imager::i_addcolors($im, $color)
index 3f55b3f..d1a7c46 100644 (file)
@@ -1,6 +1,6 @@
 #!perl -w
 use strict;
-BEGIN { $| = 1; print "1..29\n"; }
+BEGIN { $| = 1; print "1..43\n"; }
 my $loaded;
 END {print "not ok 1\n" unless $loaded;}
 use Imager qw(:all :handy);
@@ -8,6 +8,7 @@ use Imager qw(:all :handy);
 $loaded = 1;
 print "ok 1\n";
 init_log("testout/t021sixteen.log", 1);
+require "t/testtools.pl";
 
 use Imager::Color::Float;
 
@@ -71,6 +72,41 @@ print "ok 28\n";
 $oo16img->bits == 16 or print "not ";
 print "ok 29\n";
 
+my $num = 30;
+# make sure of error handling
+okn($num++, !Imager->new(xsize=>0, ysize=>1, bits=>16),
+    "fail to create a 0 pixel wide image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "and correct error message");
+
+okn($num++, !Imager->new(xsize=>1, ysize=>0, bits=>16),
+    "fail to create a 0 pixel high image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "and correct error message");
+
+okn($num++, !Imager->new(xsize=>-1, ysize=>1, bits=>16),
+    "fail to create a negative width image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "and correct error message");
+
+okn($num++, !Imager->new(xsize=>1, ysize=>-1, bits=>16),
+    "fail to create a negative height image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "and correct error message");
+
+okn($num++, !Imager->new(xsize=>-1, ysize=>-1, bits=>16),
+    "fail to create a negative width/height image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "and correct error message");
+
+okn($num++, !Imager->new(xsize=>1, ysize=>1, bits=>16, channels=>0),
+    "fail to create a zero channel image");
+matchn($num++, Imager->errstr, qr/channels must be between 1 and 4/,
+       "and correct error message");
+okn($num++, !Imager->new(xsize=>1, ysize=>1, bits=>16, channels=>5),
+    "fail to create a five channel image");
+matchn($num++, Imager->errstr, qr/channels must be between 1 and 4/,
+       "and correct error message");
 
 sub NCF {
   return Imager::Color::Float->new(@_);
index b9c3dfa..87fdbbb 100644 (file)
@@ -1,12 +1,15 @@
 #!perl -w
 use strict;
-BEGIN { $| = 1; print "1..30\n"; }
+BEGIN { $| = 1; print "1..42\n"; }
 my $loaded;
 END {print "not ok 1\n" unless $loaded;}
 use Imager qw(:all :handy);
 #use Data::Dumper;
 $loaded = 1;
 print "ok 1\n";
+
+require "t/testtools.pl";
+
 init_log("testout/t022double.log", 1);
 
 use Imager::Color::Float;
@@ -69,6 +72,32 @@ ok(29, $ooimg->bits eq 'double', "oo didn't give double image");
 my $oocopy = $ooimg->copy;
 ok(30, $oocopy->bits eq 'double', "oo copy didn't give double image");
 
+my $num = 31;
+okn($num++, !Imager->new(xsize=>0, ysize=>1, bits=>'double'),
+    "fail making 0 width image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "and correct message");
+okn($num++, !Imager->new(xsize=>1, ysize=>0, bits=>'double'),
+    "fail making 0 height image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "and correct message");
+okn($num++, !Imager->new(xsize=>-1, ysize=>1, bits=>'double'),
+    "fail making -ve width image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "and correct message");
+okn($num++, !Imager->new(xsize=>1, ysize=>-1, bits=>'double'),
+    "fail making -ve height image");
+matchn($num++, Imager->errstr, qr/Image sizes must be positive/,
+       "and correct message");
+okn($num++, !Imager->new(xsize=>1, ysize=>1, bits=>'double', channels=>0),
+    "fail making 0 channel image");
+matchn($num++, Imager->errstr, qr/channels must be between 1 and 4/,
+       "and correct message");
+okn($num++, !Imager->new(xsize=>1, ysize=>1, bits=>'double', channels=>5),
+    "fail making 5 channel image");
+matchn($num++, Imager->errstr, qr/channels must be between 1 and 4/,
+       "and correct message");
+
 sub NCF {
   return Imager::Color::Float->new(@_);
 }
diff --git a/t/t023palette.t b/t/t023palette.t
new file mode 100644 (file)
index 0000000..a247081
--- /dev/null
@@ -0,0 +1,149 @@
+#!perl -w
+# some of this is tested in t01introvert.t too
+use strict;
+my $loaded;
+BEGIN { 
+  require "t/testtools.pl";
+  $| = 1; print "1..49\n";
+}
+END { okx(0, "loading") unless $loaded; }
+use Imager;
+$loaded = 1;
+
+okx(1, "Loaded");
+
+my $img = Imager->new(xsize=>50, ysize=>50, type=>'paletted');
+
+okx($img, "paletted image created");
+
+okx($img->type eq 'paletted', "got a paletted image");
+
+my $black = Imager::Color->new(0,0,0);
+my $red = Imager::Color->new(255,0,0);
+my $green = Imager::Color->new(0,255,0);
+my $blue = Imager::Color->new(0,0,255);
+
+my $white = Imager::Color->new(255,255,255);
+
+# add some color
+my $blacki = $img->addcolors(colors=>[ $black, $red, $green, $blue ]);
+
+print "# blacki $blacki\n";
+okx(defined $blacki && $blacki == 0, "we got the first color");
+
+okx($img->colorcount() == 4, "should have 4 colors");
+my ($redi, $greeni, $bluei) = 1..3;
+
+my @all = $img->getcolors;
+okx(@all == 4, "all colors is 4");
+coloreq($all[0], $black, "first black");
+coloreq($all[1], $red, "then red");
+coloreq($all[2], $green, "then green");
+coloreq($all[3], $blue, "and finally blue");
+
+# keep this as an assignment, checking for scalar context
+# we don't want the last color, otherwise if the behaviour changes to
+# get all up to the last (count defaulting to size-index) we'd get a
+# false positive
+my $one_color = $img->getcolors(start=>$redi);
+okx($one_color->isa('Imager::Color'), "check scalar context");
+coloreq($one_color, $red, "and that it's what we want");
+
+# make sure we can find colors
+okx(!defined($img->findcolor(color=>$white)), 
+    "shouldn't be able to find white");
+okx($img->findcolor(color=>$black) == $blacki, "find black");
+okx($img->findcolor(color=>$red) == $redi, "find red");
+okx($img->findcolor(color=>$green) == $greeni, "find green");
+okx($img->findcolor(color=>$blue) == $bluei, "find blue");
+
+# various failure tests for setcolors
+okx(!defined($img->setcolors(start=>-1, colors=>[$white])),
+    "expect failure: low index");
+okx(!defined($img->setcolors(start=>1, colors=>[])),
+    "expect failure: no colors");
+okx(!defined($img->setcolors(start=>5, colors=>[$white])),
+    "expect failure: high index");
+
+# set the green index to white
+okx($img->setcolors(start => $greeni, colors => [$white]),
+    "set a color");
+# and check it
+coloreq(scalar($img->getcolors(start=>$greeni)), $white,
+       "make sure it was set");
+okx($img->findcolor(color=>$white) == $greeni, "and that we can find it");
+okx(!defined($img->findcolor(color=>$green)), "and can't find the old color");
+
+# write a few colors
+okx(scalar($img->setcolors(start=>$redi, colors=>[ $green, $red])),
+          "save multiple");
+coloreq(scalar($img->getcolors(start=>$redi)), $green, "first of multiple");
+coloreq(scalar($img->getcolors(start=>$greeni)), $red, "second of multiple");
+
+# put it back
+$img->setcolors(start=>$red, colors=>[$red, $green]);
+
+# draw on the image, make sure it stays paletted when it should
+okx($img->box(color=>$red, filled=>1), "fill with red");
+okx($img->type eq 'paletted', "paletted after fill");
+okx($img->box(color=>$green, filled=>1, xmin=>10, ymin=>10,
+             xmax=>40, ymax=>40), "green box");
+okx($img->type eq 'paletted', 'still paletted after box');
+# an AA line will almost certainly convert the image to RGB, don't use
+# an AA line here
+okx($img->line(color=>$blue, x1=>10, y1=>10, x2=>40, y2=>40),
+    "draw a line");
+okx($img->type eq 'paletted', 'still paletted after line');
+
+# draw with white - should convert to direct
+okx($img->box(color=>$white, filled=>1, xmin=>20, ymin=>20, 
+             xmax=>30, ymax=>30), "white box");
+okx($img->type eq 'direct', "now it should be direct");
+
+# various attempted to make a paletted image from our now direct image
+my $palimg = $img->to_paletted;
+okx($palimg, "we got an image");
+# they should be the same pixel for pixel
+okx(Imager::i_img_diff($img->{IMG}, $palimg->{IMG}) == 0, "same pixels");
+
+# strange case: no color picking, and no colors
+# this was causing a segmentation fault
+$palimg = $img->to_paletted(colors=>[ ], make_colors=>'none');
+okx(!defined $palimg, "to paletted with an empty palette is an error");
+print "# ",$img->errstr,"\n";
+okx(scalar($img->errstr =~ /no colors available for translation/),
+    "and got the correct msg");
+
+okx(!Imager->new(xsize=>1, ysize=>-1, type=>'paletted'), 
+    "fail on -ve height");
+matchx(Imager->errstr, qr/Image sizes must be positive/,
+       "and correct error message");
+okx(!Imager->new(xsize=>-1, ysize=>1, type=>'paletted'), 
+    "fail on -ve width");
+matchx(Imager->errstr, qr/Image sizes must be positive/,
+       "and correct error message");
+okx(!Imager->new(xsize=>-1, ysize=>-1, type=>'paletted'), 
+    "fail on -ve width/height");
+matchx(Imager->errstr, qr/Image sizes must be positive/,
+       "and correct error message");
+
+okx(!Imager->new(xsize=>1, ysize=>1, type=>'paletted', channels=>0),
+    "fail on 0 channels");
+matchx(Imager->errstr, qr/Channels must be positive and <= 4/,
+       "and correct error message");
+okx(!Imager->new(xsize=>1, ysize=>1, type=>'paletted', channels=>5),
+    "fail on 5 channels");
+matchx(Imager->errstr, qr/Channels must be positive and <= 4/,
+       "and correct error message");
+
+sub coloreq {
+  my ($left, $right, $comment) = @_;
+
+  my ($rl, $gl, $bl, $al) = $left->rgba;
+  my ($rr, $gr, $br, $ar) = $right->rgba;
+
+  print "# comparing color($rl,$gl,$bl,$al) with ($rr,$gr,$br,$ar)\n";
+  okx($rl == $rr && $gl == $gr && $bl == $br && $al == $ar,
+      $comment);
+}
+
index bccfdbc..34ed0d3 100644 (file)
@@ -1,7 +1,7 @@
 #!perl -w
 use strict;
 $|=1;
-print "1..60\n";
+print "1..61\n";
 use Imager qw(:all);
 require "t/testtools.pl";
 
@@ -28,7 +28,7 @@ i_box_filled($timg, 0, 0, 20, 20, $green);
 i_box_filled($timg, 2, 2, 18, 18, $trans);
 
 if (!i_has_format("gif")) {
-  skipn(1, 60, "no gif support");
+  skipn(1, 61, "no gif support");
 } else {
     open(FH,">testout/t105.gif") || die "Cannot open testout/t105.gif\n";
     binmode(FH);
@@ -542,6 +542,17 @@ EOS
         ++$num;
       }
     }
+
+    # try to write an image with no colors - should error
+    ok($num++, !$ooim->write(file=>"testout/t105nocolors.gif",
+                           make_colors=>'none',
+                           colors=>[], gifquant=>'gen'),
+       "write with no colors");
+
+    # try to write multiple with no colors, with separate maps
+    # I don't see a way to test this, since we don't have a mechanism
+    # to give the second image different quant options, we can't trigger
+    # a failure just for the second image
 }
 
 sub ok ($$$) {
index 8cf3465..76467e6 100644 (file)
@@ -1,3 +1,5 @@
+#!perl -w
+use strict;
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
@@ -5,23 +7,26 @@
 
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
+my $loaded;
 
-BEGIN { $| = 1; print "1..7\n"; }
+BEGIN { $| = 1; print "1..12\n"; }
 END {print "not ok 1\n" unless $loaded;}
 
 use Imager qw(:all);
 
 $loaded = 1;
 
+require "t/testtools.pl";
+
 Imager::init('log'=>'testout/t40scale.log');
 print "ok 1\n";
 
-$img=Imager->new();
+my $img=Imager->new();
 
-$img->open(file=>'testimg/scale.ppm',type=>'pnm') or print "failed: ",$scaleimg->{ERRSTR},"\n";        
+$img->open(file=>'testimg/scale.ppm',type=>'pnm') or print "failed: ",$img->{ERRSTR},"\n";     
 print "ok 2\n";        
 
-$scaleimg=$img->scale(scalefactor=>0.25) or print "failed: ",$scaleimg->{ERRSTR},"\n";
+my $scaleimg=$img->scale(scalefactor=>0.25) or print "failed: ",$img->{ERRSTR},"\n";
 print "ok 3\n";
 
 $scaleimg->write(file=>'testout/t40scale1.ppm',type=>'pnm') or print "failed: ",$scaleimg->{ERRSTR},"\n";
@@ -33,16 +38,30 @@ print "ok 5\n";
 $scaleimg->write(file=>'testout/t40scale2.ppm',type=>'pnm') or print "failed: ",$scaleimg->{ERRSTR},"\n";
 print "ok 6\n";
 
-# check for a warning when scale() is called in void context
-my $warning;
-local $SIG{__WARN__} = 
-  sub { 
-    $warning = "@_";
-    my $printed = $warning;
-    $printed =~ s/\n$//;
-    $printed =~ s/\n/\n\#/g; 
-    print "# ",$printed, "\n";
-  };
-$img->scale(scalefactor=>0.25);
-print $warning =~ /void/ ? "ok 7\n" : "not ok 7\n";
+{
+  # check for a warning when scale() is called in void context
+  my $warning;
+  local $SIG{__WARN__} = 
+    sub { 
+      $warning = "@_";
+      my $printed = $warning;
+      $printed =~ s/\n$//;
+      $printed =~ s/\n/\n\#/g; 
+      print "# ",$printed, "\n";
+    };
+  $img->scale(scalefactor=>0.25);
+  print $warning =~ /void/ ? "ok 7\n" : "not ok 7\n";
+  print $warning =~ /t40scale\.t/ ? "ok 8\n" : "not ok 8\n";
+}
+{ # https://rt.cpan.org/Ticket/Display.html?id=7467
+  # segfault in Imager 0.43
+  # make sure scale() doesn't let us make an image zero pixels high or wide
+  # it does this by making the given axis as least 1 pixel high
+  my $out = $img->scale(scalefactor=>0.00001);
+  print $out->getwidth == 1 ? "ok 9\n" : "not ok 9\n";
+  print $out->getheight == 1 ? "ok 10\n" : "not ok 10\n";
 
+  $out = $img->scale(scalefactor=>0.00001, qtype => 'preview');
+  print $out->getwidth == 1 ? "ok 11\n" : "not ok 11\n";
+  print $out->getheight == 1 ? "ok 12\n" : "not ok 12\n";
+}
index ec46d30..f612531 100644 (file)
@@ -74,5 +74,25 @@ sub requireokx {
   }
 }
 
+sub matchn($$$$) {
+  my ($num, $str, $re, $comment) = @_;
+
+  my $match = $str =~ $re;
+  okn($num, $match, $comment);
+  unless ($match) {
+    $str =~ s/\\/\\\\/g;
+    $str =~ s/[^\x20-\x7E]/"\\x".sprintf("%02X", ord($1))/ge;
+    print "# The string '$str'\n";
+    print "# did not match '$re'\n";
+  }
+  return $match;
+}
+
+sub matchx($$$) {
+  my ($str, $re, $comment) = @_;
+
+  matchn($TESTNUM++, $str, $re, $comment);
+}
+
 1;