and test for it.
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR %OPCODES $I2P $FORMATGUESS $warn_obsolete);
use IO::File;
-
+use Scalar::Util;
use Imager::Color;
use Imager::Font;
sub copy {
my $self = shift;
- unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ $self->_valid_image("copy")
+ or return;
unless (defined wantarray) {
my @caller = caller;
sub paste {
my $self = shift;
- unless ($self->{IMG}) {
- $self->_set_error('empty input image');
- return;
- }
+ $self->_valid_image("paste")
+ or return;
+
my %input=(left=>0, top=>0, src_minx => 0, src_miny => 0, @_);
my $src = $input{img} || $input{src};
unless($src) {
$self->_set_error("no source image");
return;
}
+ unless ($src->_valid_image("paste")) {
+ $self->{ERRSTR} = $src->{ERRSTR} . " (for src)";
+ return;
+ }
$input{left}=0 if $input{left} <= 0;
$input{top}=0 if $input{top} <= 0;
sub crop {
my $self=shift;
- unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ $self->_valid_image("crop")
+ or return;
unless (defined wantarray) {
my @caller = caller;
sub _sametype {
my ($self, %opts) = @_;
- $self->{IMG} or return $self->_set_error("Not a valid image");
+ $self->_valid_image
+ or return;
my $x = $opts{xsize} || $self->getwidth;
my $y = $opts{ysize} || $self->getheight;
sub masked {
my $self = shift;
- $self or return undef;
+ $self->_valid_image("masked")
+ or return;
+
my %opts = (left => 0,
top => 0,
right => $self->getwidth,
return;
}
- $self->_valid_image
+ $self->_valid_image("to_paletted")
or return;
my $result = Imager->new;
return;
}
- $self->_valid_image
+ $self->_valid_image("to_rgb8")
or return;
my $result = Imager->new;
return;
}
- $self->_valid_image
+ $self->_valid_image("to_rgb16")
or return;
my $result = Imager->new;
return;
}
- $self->_valid_image
+ $self->_valid_image("to_rgb_double")
or return;
my $result = Imager->new;
my $self = shift;
my %opts = (colors=>[], @_);
- unless ($self->{IMG}) {
- $self->_set_error("empty input image");
- return;
- }
+ $self->_valid_image("addcolors")
+ or return -1;
my @colors = @{$opts{colors}}
or return undef;
my $self = shift;
my %opts = (start=>0, colors=>[], @_);
- unless ($self->{IMG}) {
- $self->_set_error("empty input image");
- return;
- }
+ $self->_valid_image("setcolors")
+ or return;
my @colors = @{$opts{colors}}
or return undef;
sub getcolors {
my $self = shift;
my %opts = @_;
+
+ $self->_valid_image("getcolors")
+ or return;
+
if (!exists $opts{start} && !exists $opts{count}) {
# get them all
$opts{start} = 0;
elsif (!exists $opts{start}) {
$opts{start} = 0;
}
-
- $self->{IMG} and
- return i_getcolors($self->{IMG}, $opts{start}, $opts{count});
+
+ return i_getcolors($self->{IMG}, $opts{start}, $opts{count});
}
sub colorcount {
- i_colorcount($_[0]{IMG});
+ my ($self) = @_;
+
+ $self->_valid_image("colorcount")
+ or return -1;
+
+ return i_colorcount($self->{IMG});
}
sub maxcolors {
- i_maxcolors($_[0]{IMG});
+ my $self = shift;
+
+ $self->_valid_image("maxcolors")
+ or return -1;
+
+ i_maxcolors($self->{IMG});
}
sub findcolor {
my $self = shift;
my %opts = @_;
- $opts{color} or return undef;
- $self->{IMG} and i_findcolor($self->{IMG}, $opts{color});
+ $self->_valid_image("findcolor")
+ or return;
+
+ unless ($opts{color}) {
+ $self->_set_error("findcolor: no color parameter");
+ return;
+ }
+
+ my $color = _color($opts{color})
+ or return;
+
+ return i_findcolor($self->{IMG}, $color);
}
sub bits {
my $self = shift;
- my $bits = $self->{IMG} && i_img_bits($self->{IMG});
+
+ $self->_valid_image("bits")
+ or return;
+
+ my $bits = i_img_bits($self->{IMG});
if ($bits && $bits == length(pack("d", 1)) * 8) {
$bits = 'double';
}
- $bits;
+ return $bits;
}
sub type {
my $self = shift;
- if ($self->{IMG}) {
- return i_img_type($self->{IMG}) ? "paletted" : "direct";
- }
+
+ $self->_valid_image("type")
+ or return;
+
+ return i_img_type($self->{IMG}) ? "paletted" : "direct";
}
sub virtual {
my $self = shift;
- $self->{IMG} and i_img_virtual($self->{IMG});
+
+ $self->_valid_image("virtual")
+ or return;
+
+ return i_img_virtual($self->{IMG});
}
sub is_bilevel {
my ($self) = @_;
- $self->{IMG} or return;
+ $self->_valid_image("is_bilevel")
+ or return;
return i_img_is_monochrome($self->{IMG});
}
sub tags {
my ($self, %opts) = @_;
- $self->{IMG} or return;
+ $self->_valid_image("tags")
+ or return;
if (defined $opts{name}) {
my @result;
my $self = shift;
my %opts = @_;
- return -1 unless $self->{IMG};
+ $self->_valid_image("addtag")
+ or return;
+
if ($opts{name}) {
if (defined $opts{value}) {
if ($opts{value} =~ /^\d+$/) {
my $self = shift;
my %opts = @_;
- return 0 unless $self->{IMG};
+ $self->_valid_image("deltag")
+ or return 0;
if (defined $opts{'index'}) {
return i_tags_delete($self->{IMG}, $opts{'index'});
sub settag {
my ($self, %opts) = @_;
+ $self->_valid_image("settag")
+ or return;
+
if ($opts{name}) {
$self->deltag(name=>$opts{name});
return $self->addtag(name=>$opts{name}, value=>$opts{value});
fax_fine=>1, @_);
my $rc;
+ $self->_valid_image("write")
+ or return;
+
$self->_set_opts(\%input, "i_", $self)
or return undef;
- unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
-
my $type = $input{'type'};
if (!$type and $input{file}) {
$type = $FORMATGUESS->($input{file});
return;
}
# translate to ImgRaw
- if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
- $class->_set_error('Usage: Imager->write_multi({ options }, @images)');
- return 0;
+ my $index = 1;
+ for my $img (@images) {
+ unless ($img->_valid_image("write_multi")) {
+ $class->_set_error($img->errstr . " (image $index)");
+ return;
+ }
+ ++$index;
}
$class->_set_opts($opts, "i_", @images)
or return;
my $self=shift;
my %input=@_;
my %hsh;
- unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ $self->_valid_image("filter")
+ or return;
if (!$input{'type'}) { $self->{ERRSTR}='type parameter missing'; return undef; }
return;
}
- unless ($self->{IMG}) {
- $self->_set_error('empty input image');
- return undef;
- }
+ $self->_valid_image("scale")
+ or return;
my ($x_scale, $y_scale, $new_width, $new_height) =
$self->scale_calculate(%opts)
return;
}
- unless ($self->{IMG}) {
- $self->{ERRSTR} = 'empty input image';
- return undef;
- }
+ $self->_valid_image("scaleX")
+ or return;
my $img = Imager->new();
return;
}
- unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+ $self->_valid_image("scaleY")
+ or return;
my $img = Imager->new();
sub transform {
my $self=shift;
- unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
my %opts=@_;
my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
# print Dumper(\%opts);
# xopcopdes
+ $self->_valid_image("transform")
+ or return;
+
if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
if (!$I2P) {
eval ("use Affix::Infix2Postfix;");
$opts->{variables} = [ qw(x y) ];
my ($width, $height) = @{$opts}{qw(width height)};
if (@imgs) {
+ my $index = 1;
+ for my $img (@imgs) {
+ unless ($img->_valid_image("transform2")) {
+ Imager->_set_error($img->errstr . " (input image $index)");
+ return;
+ }
+ ++$index;
+ }
+
$width ||= $imgs[0]->getwidth();
$height ||= $imgs[0]->getheight();
my $img_num = 1;
my $self=shift;
my %opts= @_;
- unless ($self->{IMG}) {
- $self->{ERRSTR}='empty input image';
- return undef;
- }
- unless ($opts{src} && $opts{src}->{IMG}) {
- $self->{ERRSTR}='empty input image for src';
- return undef;
+ $self->_valid_image("rubthrough")
+ or return;
+
+ unless ($opts{src} && $opts{src}->_valid_image("rubthrough")) {
+ $self->{ERRSTR} = $opts{src}{ERRSTR} . ' (for src)';
+ return;
}
%opts = (src_minx => 0,
@_
);
- unless ($self->{IMG}) {
- $self->_set_error("compose: empty input image");
- return;
- }
+ $self->_valid_image("compose")
+ or return;
unless ($opts{src}) {
$self->_set_error("compose: src parameter missing");
return;
}
- unless ($opts{src}{IMG}) {
- $self->_set_error("compose: src parameter empty image");
+ unless ($opts{src}->_valid_image("compose")) {
+ $self->_set_error($opts{src}->errstr . " (for src)");
return;
}
my $src = $opts{src};
my $combine = $self->_combine($opts{combine}, 'normal');
if ($opts{mask}) {
- unless ($opts{mask}{IMG}) {
- $self->_set_error("compose: mask parameter empty image");
+ unless ($opts{mask}->_valid_image("compose")) {
+ $self->_set_error($opts{mask}->errstr . " (for mask)");
return;
}
sub flip {
my $self = shift;
my %opts = @_;
+
+ $self->_valid_image("flip")
+ or return;
+
my %xlate = (h=>0, v=>1, hv=>2, vh=>2);
my $dir;
return () unless defined $opts{'dir'} and defined $xlate{$opts{'dir'}};
return;
}
+ $self->_valid_image("rotate")
+ or return;
+
if (defined $opts{right}) {
my $degrees = $opts{right};
if ($degrees < 0) {
my $self = shift;
my %opts = @_;
+ $self->_valid_image("matrix_transform")
+ or return;
+
unless (defined wantarray) {
my @caller = caller;
warn "copy() called in void context - copy() returns the copied image at $caller[1] line $caller[2]\n";
my $self=shift;
my $raw = $self->{IMG};
- unless ($raw) {
- $self->{ERRSTR}='empty input image';
- return undef;
- }
+ $self->_valid_image("box")
+ or return;
my %opts = @_;
sub arc {
my $self=shift;
- unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ $self->_valid_image("arc")
+ or return;
+
my $dflcl= [ 255, 255, 255, 255];
my $good = 1;
my %opts=
my %opts=(color=>$dflcl,
endp => 1,
@_);
- unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ $self->_valid_image("line")
+ or return;
unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
my $dflcl=i_color_new(0,0,0,0);
my %opts=(color=>$dflcl,@_);
- unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+ $self->_valid_image("polyline")
+ or return;
if (exists($opts{points})) { @points=@{$opts{points}}; }
if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
my $dflcl = i_color_new(0,0,0,0);
my %opts = (color=>$dflcl, @_);
- unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+ $self->_valid_image("polygon")
+ or return;
if (exists($opts{points})) {
$opts{'x'} = [ map { $_->[0] } @{$opts{points}} ];
my $dflcl=i_color_new(0,0,0,0);
my %opts=(color=>$dflcl,@_);
- unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+ $self->_valid_image("polybezier")
+ or return;
if (exists $opts{points}) {
$opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
my %opts = ( color=>Imager::Color->new(255, 255, 255), @_ );
my $rc;
+ $self->_valid_image("flood_fill")
+ or return;
+
unless (exists $opts{'x'} && exists $opts{'y'}) {
$self->{ERRSTR} = "missing seed x and y parameters";
return undef;
my $self = shift;
my %opts = ( type => '8bit', x=>0, @_);
- $self->_valid_image or return;
+ $self->_valid_image("getscanline")
+ or return;
defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
my $self = shift;
my %opts = ( x=>0, @_);
- $self->_valid_image or return;
+ $self->_valid_image("setscanline")
+ or return;
unless (defined $opts{'y'}) {
$self->_set_error("missing y parameter");
my $self = shift;
my %opts = ( type => '8bit', x=>0, offset => 0, @_);
+ $self->_valid_image("getsamples")
+ or return;
+
defined $opts{width} or $opts{width} = $self->getwidth - $opts{x};
unless (defined $opts{'y'}) {
sub setsamples {
my $self = shift;
- unless ($self->{IMG}) {
- $self->_set_error('setsamples: empty input image');
- return;
- }
+ $self->_valid_image("setsamples")
+ or return;
my %opts = ( x => 0, offset => 0 );
my $data_index;
my ($self, %opts) = @_;
my $matrix;
+ $self->_valid_image("convert")
+ or return;
+
unless (defined wantarray) {
my @caller = caller;
warn "convert() called in void context - convert() returns the converted image at $caller[1] line $caller[2]\n";
$class->_set_error("src must contain image objects");
return;
}
- unless ($img->{IMG}) {
- $class->_set_error("empty input image");
+ unless ($img->_valid_image("combine")) {
+ $Imager::ERRSTR = $img->{ERRSTR} . " (src->[$index])";
return;
}
push @imgs, $img->{IMG};
my ($self, %opts) = @_;
my @chlist = qw( red green blue alpha );
+ $self->_valid_image("map")
+ or return;
+
if (!exists($opts{'maps'})) {
# make maps from channel maps
my $chnum;
sub difference {
my ($self, %opts) = @_;
+ $self->_valid_image("difference")
+ or return;
+
defined $opts{mindist} or $opts{mindist} = 0;
defined $opts{other}
or return $self->_set_error("No 'other' parameter supplied");
- defined $opts{other}{IMG}
- or return $self->_set_error("No image data in 'other' image");
-
- $self->{IMG}
- or return $self->_set_error("No image data");
+ unless ($opts{other}->_valid_image("difference")) {
+ $self->_set_error($opts{other}->errstr . " (other image)");
+ return;
+ }
my $result = Imager->new;
$result->{IMG} = i_diff_image($self->{IMG}, $opts{other}{IMG},
sub getwidth {
my $self = shift;
- if (my $raw = $self->{IMG}) {
- return i_img_get_width($raw);
- }
- else {
- $self->{ERRSTR} = 'image is empty'; return undef;
- }
+ $self->_valid_image("getwidth")
+ or return;
+
+ return i_img_get_width($self->{IMG});
}
# Get the height of an image
sub getheight {
my $self = shift;
- if (my $raw = $self->{IMG}) {
- return i_img_get_height($raw);
- }
- else {
- $self->{ERRSTR} = 'image is empty'; return undef;
- }
+ $self->_valid_image("getheight")
+ or return;
+
+ return i_img_get_height($self->{IMG});
}
# Get number of channels in an image
sub getchannels {
my $self = shift;
- if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
+
+ $self->_valid_image("getchannels")
+ or return;
+
return i_img_getchannels($self->{IMG});
}
sub getmask {
my $self = shift;
- if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
+
+ $self->_valid_image("getmask")
+ or return;
+
return i_img_getmask($self->{IMG});
}
sub setmask {
my $self = shift;
my %opts = @_;
- if (!defined($self->{IMG})) {
- $self->{ERRSTR} = 'image is empty';
- return undef;
- }
+
+ $self->_valid_image("setmask")
+ or return;
+
unless (defined $opts{mask}) {
$self->_set_error("mask parameter required");
return;
}
+
i_img_setmask( $self->{IMG} , $opts{mask} );
1;
sub getcolorcount {
my $self=shift;
my %opts=('maxcolors'=>2**30,@_);
- if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
+
+ $self->_valid_image("getcolorcount")
+ or return;
+
my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
return ($rc==-1? undef : $rc);
}
# values are the number of pixels in this colour.
sub getcolorusagehash {
my $self = shift;
-
+
+ $self->_valid_image("getcolorusagehash")
+ or return;
+
my %opts = ( maxcolors => 2**30, @_ );
my $max_colors = $opts{maxcolors};
unless (defined $max_colors && $max_colors > 0) {
return;
}
- unless (defined $self->{IMG}) {
- $self->_set_error('empty input image');
- return;
- }
-
my $channels= $self->getchannels;
# We don't want to look at the alpha channel, because some gifs using it
# doesn't define it for every colour (but only for some)
sub getcolorusage {
my $self = shift;
+ $self->_valid_image("getcolorusage")
+ or return;
+
my %opts = ( maxcolors => 2**30, @_ );
my $max_colors = $opts{maxcolors};
unless (defined $max_colors && $max_colors > 0) {
return;
}
- unless (defined $self->{IMG}) {
- $self->_set_error('empty input image');
- return undef;
- }
-
return i_get_anonymous_color_histo($self->{IMG}, $max_colors);
}
sub string {
my $self = shift;
- unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ $self->_valid_image("string")
+ or return;
my %input=('x'=>0, 'y'=>0, @_);
defined($input{string}) or $input{string} = $input{text};
my $img;
if (ref $self) {
- unless ($self->{IMG}) {
- $self->{ERRSTR}='empty input image';
- return;
- }
+ $self->_valid_image("align_string")
+ or return;
+
$img = $self;
}
else {
RETVAL
-void
+undef_int
i_map(im, pmaps)
Imager::ImgRaw im
PREINIT:
}
i_map(im, maps, mask);
myfree(maps);
+ RETVAL = 1;
+ OUTPUT:
+ RETVAL
lib/Imager/Font/BBox.pm
lib/Imager/Font/FreeType2.pm
lib/Imager/Font/Image.pm
+lib/Imager/Font/Test.pm Font for testing (outputs boxes only)
lib/Imager/Font/Truetype.pm
lib/Imager/Font/Type1.pm Compatibility wrapper for Imager::Font::T1
lib/Imager/Font/Wrap.pm
# sub-module build junk
\.bak$
+MYMETA.json
\ No newline at end of file
--- /dev/null
+package Imager::Font::Test;
+use strict;
+
+use base 'Imager::Font';
+
+sub new {
+ my ($class, %opts) = @_;
+
+ bless \%opts, shift;
+}
+
+sub _draw {
+ my ($self, %input) = @_;
+
+ my $text = $input{string};
+
+ my $ppn = int($input{size} * 0.5 + 0.5);
+ my $desc = int($input{size} * 0.3 + 0.5);
+ my $asc = $input{size} - $desc;
+ my $width = $ppn * length $text;
+ my $x = $input{x};
+ my $y = $input{'y'};
+ $input{align} and $y -= $asc;
+
+ $input{image}->box(color => $input{color}, xmin => $x, ymin => $y,
+ xmax => $x + $width-1, ymax => $y + $input{size} - 1);
+
+ return 1;
+}
+
+sub _bounding_box {
+ my ($self, %input) = @_;
+
+ my $text = $input{string};
+
+ my $ppn = int($input{size} * 0.5 + 0.5);
+ my $desc = int($input{size} * 0.3 + 0.5);
+ my $asc = $input{size} - $desc;
+
+ return ( 0, -$desc, $ppn * length $text, $asc, -$desc, $asc, $ppn * length $text, 0 );
+}
+
+sub has_chars {
+ my ($self, %input) = @_;
+
+ my $text = $input{string};
+ defined $text
+ or return Imager->_set_error("has_chars: No string parameter supplied");
+
+ return (1) x length $text;
+}
+
+sub face_name {
+ "test";
+}
+
+sub glyph_names {
+ my ($self, %input) = @_;
+
+ my $text = $input{string};
+ defined $text
+ or return Imager->_set_error("glyph_names: No string parameter supplied");
+
+ return (1) x length $text;
+}
+
+1;
+
+=head1 NAME'
+
+Imager::Font::Test - font driver producing consistent output for tests.
+
+=head1 SYNOPSIS
+
+ my $font = Imager::Font::Test->new;
+
+ # use $font where you use other fonts
+
+=head1 DESCRIPTION
+
+Imager::Font::Test is intended to produce consistent output without
+being subject to the inconsistent output produced by different
+versions of font libraries.
+
+The output is simple box for the whole string.
+
+=head1 AUTHOR
+
+Tony Cook <tonyc@cpan.org>
+
+=cut
+
# to make sure we get expected values
use strict;
-use Test::More tests => 434;
+use Test::More tests => 466;
BEGIN { use_ok(Imager => qw(:handy :all)) }
is($impal3->type, 'paletted', "and is paletted");
}
-{ # to_rgb on incomplete image
+{
my $im = Imager->new;
ok($im, "make empty image");
ok(!$im->to_rgb8, "convert to rgb8");
- is($im->errstr, "empty input image", "check message");
+ is($im->errstr, "to_rgb8: empty input image", "check message");
+ is($im->bits, undef, "can't call bits on an empty image");
+ is($im->errstr, "bits: empty input image", "check message");
+ is($im->type, undef, "can't call type on an empty image");
+ is($im->errstr, "type: empty input image", "check message");
+ is($im->virtual, undef, "can't call virtual on an empty image");
+ is($im->errstr, "virtual: empty input image", "check message");
+ is($im->is_bilevel, undef, "can't call virtual on an empty image");
+ is($im->errstr, "is_bilevel: empty input image", "check message");
+ ok(!$im->getscanline(y => 0), "can't call getscanline on an empty image");
+ is($im->errstr, "getscanline: empty input image", "check message");
+ ok(!$im->setscanline(y => 0, pixels => [ $red, $blue ]),
+ "can't call setscanline on an empty image");
+ is($im->errstr, "setscanline: empty input image", "check message");
+ ok(!$im->getsamples(y => 0), "can't call getsamples on an empty image");
+ is($im->errstr, "getsamples: empty input image", "check message");
+ is($im->getwidth, undef, "can't get width of empty image");
+ is($im->errstr, "getwidth: empty input image", "check message");
+ is($im->getheight, undef, "can't get height of empty image");
+ is($im->errstr, "getheight: empty input image", "check message");
+ is($im->getchannels, undef, "can't get channels of empty image");
+ is($im->errstr, "getchannels: empty input image", "check message");
+ is($im->getmask, undef, "can't get mask of empty image");
+ is($im->errstr, "getmask: empty input image", "check message");
+ is($im->setmask, undef, "can't set mask of empty image");
+ is($im->errstr, "setmask: empty input image", "check message");
}
{ # basic checks, 8-bit direct images
}
}
+{
+ my $empty = Imager->new;
+ ok(!$empty->addtag(name => "foo", value => 1),
+ "can't addtag on an empty image");
+ is($empty->errstr, "addtag: empty input image",
+ "check error message");
+ ok(!$empty->settag(name => "foo", value => 1),
+ "can't settag on an empty image");
+ is($empty->errstr, "settag: empty input image",
+ "check error message");
+ ok(!$empty->deltag(name => "foo"), "can't deltag on an empty image");
+ is($empty->errstr, "deltag: empty input image",
+ "check error message");
+ ok(!$empty->tags(name => "foo"), "can't tags on an empty image");
+ is($empty->errstr, "tags: empty input image",
+ "check error message");
+}
+
Imager->close_log();
unless ($ENV{IMAGER_KEEP_FILES}) {
#!perl -w
use strict;
-use Test::More tests => 242;
+use Test::More tests => 244;
use Imager qw(:all :handy);
use Imager::Test qw(is_color3 is_fcolor3);
"check values written");
}
+{
+ my $empty = Imager->new;
+ ok(!$empty->masked, "fail to make a masked image from an empty");
+ is($empty->errstr, "masked: empty input image",
+ "check error message");
+}
+
Imager->close_log();
unless ($ENV{IMAGER_KEEP_FILES}) {
my $im = Imager->new;
ok($im, "make empty image");
ok(!$im->to_rgb16, "convert empty image to 16-bit");
- is($im->errstr, "empty input image", "check message");
+ is($im->errstr, "to_rgb16: empty input image", "check message");
}
{ # bounds checks
my $im = Imager->new;
ok($im, "make empty image");
ok(!$im->to_rgb_double, "convert empty image to double");
- is($im->errstr, "empty input image", "check message");
+ is($im->errstr, "to_rgb_double: empty input image", "check message");
}
my $psamp_outside_error = "Image position outside of image";
#!perl -w
# some of this is tested in t01introvert.t too
use strict;
-use Test::More tests => 211;
+use Test::More tests => 226;
BEGIN { use_ok("Imager", ':handy'); }
use Imager::Test qw(image_bounds_checks test_image is_color3 isnt_image is_color4 is_fcolor3);
print "# blacki $blacki\n";
ok(defined $blacki && $blacki == 0, "we got the first color");
-ok($img->colorcount() == 4, "should have 4 colors");
+is($img->colorcount(), 4, "should have 4 colors");
+is($img->maxcolors, 256, "maxcolors always 256");
+
my ($redi, $greeni, $bluei) = 1..3;
my @all = $img->getcolors;
0, 0, 1.0, "get a pixel in float form, make sure it's blue");
}
+{
+ my $empty = Imager->new;
+ ok(!$empty->to_paletted, "can't convert an empty image");
+ is($empty->errstr, "to_paletted: empty input image",
+ "check error message");
+
+ is($empty->addcolors(colors => [ $black ]), -1,
+ "can't addcolors() to an empty image");
+ is($empty->errstr, "addcolors: empty input image",
+ "check error message");
+
+ ok(!$empty->setcolors(colors => [ $black ]),
+ "can't setcolors() to an empty image");
+ is($empty->errstr, "setcolors: empty input image",
+ "check error message");
+
+ ok(!$empty->getcolors(),
+ "can't getcolors() from an empty image");
+ is($empty->errstr, "getcolors: empty input image",
+ "check error message");
+
+ is($empty->colorcount, -1, "can't colorcount() an empty image");
+ is($empty->errstr, "colorcount: empty input image",
+ "check error message");
+
+ is($empty->maxcolors, -1, "can't maxcolors() an empty image");
+ is($empty->errstr, "maxcolors: empty input image",
+ "check error message");
+
+ is($empty->findcolor(color => $blue), undef,
+ "can't findcolor an empty image");
+ is($empty->errstr, "findcolor: empty input image",
+ "check error message");
+}
+
Imager->close_log;
unless ($ENV{IMAGER_KEEP_FILES}) {
# the file format
use strict;
-use Test::More tests => 85;
+use Test::More tests => 89;
use Imager;
-d "testout" or mkdir "testout";
}
}
+{ # test empty image handling for write()/write_multi()
+ my $empty = Imager->new;
+ my $data;
+ ok(!$empty->write(data => \$data, type => "pnm"),
+ "fail to write an empty image");
+ is($empty->errstr, "write: empty input image", "check error message");
+ my $good = Imager->new(xsize => 1, ysize => 1);
+ ok(!Imager->write_multi({ data => \$data, type => "pnm" }, $good, $empty),
+ "fail to write_multi an empty image");
+ is(Imager->errstr, "write_multi: empty input image (image 2)");
+}
+
# check file type probe
probe_ok("49492A41", undef, "not quite tiff");
probe_ok("4D4D0041", undef, "not quite tiff");
#!perl -w
use strict;
-use Test::More tests => 244;
+use Test::More tests => 256;
use Imager ':all';
use Imager::Test qw(is_color3 is_image);
use constant PI => 3.14159265358979;
}
}
+{
+ my $empty = Imager->new;
+ ok(!$empty->box(), "can't draw box to empty image");
+ is($empty->errstr, "box: empty input image", "check error message");
+ ok(!$empty->arc(), "can't draw arc to empty image");
+ is($empty->errstr, "arc: empty input image", "check error message");
+ ok(!$empty->line(x1 => 0, y1 => 0, x2 => 10, y2 => 0),
+ "can't draw line to empty image");
+ is($empty->errstr, "line: empty input image", "check error message");
+ ok(!$empty->polyline(points => [ [ 0, 0 ], [ 10, 0 ] ]),
+ "can't draw polyline to empty image");
+ is($empty->errstr, "polyline: empty input image", "check error message");
+ ok(!$empty->polygon(points => [ [ 0, 0 ], [ 10, 0 ], [ 0, 10 ] ]),
+ "can't draw polygon to empty image");
+ is($empty->errstr, "polygon: empty input image", "check error message");
+ ok(!$empty->flood_fill(x => 0, y => 0), "can't flood fill to empty image");
+ is($empty->errstr, "flood_fill: empty input image", "check error message");
+}
+
malloc_state();
#!perl -w
use strict;
use Imager;
-use Test::More tests => 10;
+use Test::More tests => 14;
unshift @INC, "t";
or skip("Failed to load", 1);
ok($good->isa("GoodTestFont"), "and it's the right type");
}
+
+
+use Imager::Font::Test;
+
+# check string() and align_string() handle an empty image
+{
+ my $font = Imager::Font::Test->new;
+ my $empty = Imager->new;
+ ok(!$empty->string(text => "foo", x => 0, y => 10, size => 10, font => $font),
+ "can't draw text on an empty image");
+ is($empty->errstr, "string: empty input image",
+ "check error message");
+ ok(!$empty->align_string(text => "foo", x => 0, y => 10, size => 10, font => $font),
+ "can't draw text on an empty image");
+ is($empty->errstr, "align_string: empty input image",
+ "check error message");
+}
{ # error handling - NULL image
my $im = Imager->new;
ok(!$im->scale(scalefactor => 0.5), "try to scale empty image");
- is($im->errstr, "empty input image", "check error message");
+ is($im->errstr, "scale: empty input image", "check error message");
# scaleX/scaleY
ok(!$im->scaleX(scalefactor => 0.5), "try to scaleX empty image");
- is($im->errstr, "empty input image", "check error message");
+ is($im->errstr, "scaleX: empty input image", "check error message");
ok(!$im->scaleY(scalefactor => 0.5), "try to scaleY empty image");
- is($im->errstr, "empty input image", "check error message");
+ is($im->errstr, "scaleY: empty input image", "check error message");
}
{ # invalid qtype value
eval "use Affix::Infix2Postfix; 1;"
or plan skip_all => "No Affix::Infix2Postfix";
-plan tests => 6;
+plan tests => 8;
#$Imager::DEBUG=1;
}
}
-
+{
+ my $empty = Imager->new;
+ ok(!$empty->transform(xexpr => "x", yexpr => "y"),
+ "fail to transform an empty image");
+ is($empty->errstr, "transform: empty input image",
+ "check error message");
+}
#!perl -w
use strict;
-use Test::More tests => 38;
+use Test::More tests => 40;
BEGIN { use_ok('Imager'); }
use Imager::Test qw(is_color3);
0 0 getp1 sat 255 * 0.01 + 0 0 rgb
EOS
+
+{
+ my $empty = Imager->new;
+ my $good = Imager->new(xsize => 1, ysize => 1);
+ ok(!Imager::transform2({ rpnexpr => "x y getp1" }, $good, $empty),
+ "can't transform an empty image");
+ is(Imager->errstr, "transform2: empty input image (input image 2)",
+ "check error message");
+}
+
use Imager::Transform;
# some simple tests
#!perl -w
use strict;
use Imager qw(:handy);
-use Test::More tests => 116;
+use Test::More tests => 122;
-d "testout" or mkdir "testout";
is_image($diff2, $cmp2, "difference() - check image with mindist 1.1 - large samples");
}
+{
+ my $empty = Imager->new;
+ ok(!$empty->filter(type => "hardinvert"), "can't filter an empty image");
+ is($empty->errstr, "filter: empty input image",
+ "check error message");
+ ok(!$empty->difference(other => $imbase), "can't difference empty image");
+ is($empty->errstr, "difference: empty input image",
+ "check error message");
+ ok(!$imbase->difference(other => $empty),
+ "can't difference against empty image");
+ is($imbase->errstr, "difference: empty input image (other image)",
+ "check error message");
+}
+
sub test {
my ($in, $params, $out) = @_;
#!perl -w
use strict;
use Imager qw(:handy);
-use Test::More tests => 114;
+use Test::More tests => 120;
use Imager::Test qw(is_image is_imaged);
-d "testout" or mkdir "testout";
}
}
+{
+ my $empty = Imager->new;
+ my $good = Imager->new(xsize => 1, ysize => 1);
+ ok(!$empty->compose(src => $good), "can't compose to empty image");
+ is($empty->errstr, "compose: empty input image",
+ "check error message");
+ ok(!$good->compose(src => $empty), "can't compose from empty image");
+ is($good->errstr, "compose: empty input image (for src)",
+ "check error message");
+ ok(!$good->compose(src => $good, mask => $empty),
+ "can't compose with empty mask");
+ is($good->errstr, "compose: empty input image (for mask)",
+ "check error message");
+}
+
unless ($ENV{IMAGER_KEEP_FILES}) {
unlink @files;
}
# bad image error
my $im = Imager->new;
ok(!Imager->combine(src => [ $im ]), "empty image");
- is(Imager->errstr, "empty input image", "check message");
+ is(Imager->errstr, "combine: empty input image (src->[0])",
+ "check message");
}
{
#!perl -w
use strict;
-use Test::More tests => 87;
+use Test::More tests => 95;
use Imager;
use Imager::Test qw(is_color3 is_image is_imaged test_image_double test_image isnt_image is_image_similar);
my $diff = Imager::i_img_diff($img->{IMG}, $nimg->{IMG});
is_image($img, $nimg, "copy matches source");
+{
+ my $empty = Imager->new;
+ ok(!$empty->copy, "fail to copy an empty image");
+ is($empty->errstr, "copy: empty input image", "check error message");
+}
+
# test if ->flip(dir=>'h')->flip(dir=>'h') doesn't alter the image
$nimg->flip(dir=>"h")->flip(dir=>"h");
is_image($nimg, $img, "double horiz flipped matches original");
$nimg->flip(dir=>"v")->flip(dir=>"h")->flip(dir=>"hv");;
is_image($img, $nimg, "check flip with hv matches flip v then flip h");
+{
+ my $empty = Imager->new;
+ ok(!$empty->flip(dir => "v"), "fail to flip an empty image");
+ is($empty->errstr, "flip: empty input image", "check error message");
+}
+
{
my $imsrc = test_image_double;
my $imcp = $imsrc->copy;
$trimg->write(file=>"testout/t64_trans_back.ppm")
or print "# Cannot save: ",$trimg->errstr,"\n";
+{
+ my $empty = Imager->new;
+ ok(!$empty->matrix_transform(matrix => [ 1, 0, 0,
+ 0, 1, 0,
+ 0, 0, 1 ]),
+ "can't transform an empty image");
+ is($empty->errstr, "matrix_transform: empty input image",
+ "check error message");
+}
+
sub rot_test {
my ($src, $degrees, $count) = @_;
# my $diff = $right->difference(other => $deg, mindist => 1);
# $diff->write(file => "testout/t64rotdiff.png");
}
+
+{
+ my $empty = Imager->new;
+ ok(!$empty->rotate(degrees => 90), "can't rotate an empty image");
+ is($empty->errstr, "rotate: empty input image",
+ "check error message");
+}
#!perl -w
use strict;
-use Test::More tests => 64;
+use Test::More tests => 66;
use Imager;
use Imager::Test qw(test_image);
"outside of image" );
cmp_ok($src->errstr, '=~', qr/outside of the image/, "and message");
}
+
+{
+ my $empty = Imager->new;
+ ok(!$empty->crop(left => 10), "can't crop an empty image");
+ is($empty->errstr, "crop: empty input image", "check message");
+}
#!perl -w
use strict;
-use Test::More tests => 54;
+use Test::More tests => 60;
use Imager;
use Imager::Test qw(is_image);
ok($img->write(type=>'pnm',file=>'testout/t66.ppm'), "save it")
or print "# ", $img->errstr, "\n";
+{
+ my $empty = Imager->new;
+ ok(!$empty->paste(src => $nimg), "paste into empty image");
+ is($empty->errstr, "paste: empty input image",
+ "check error message");
+
+ ok(!$img->paste(src => $empty), "paste from empty image");
+ is($img->errstr, "paste: empty input image (for src)",
+ "check error message");
+
+ ok(!$img->paste(), "no source image");
+ is($img->errstr, "no source image");
+}
+
# more stringent tests
{
my $src = Imager->new(xsize => 100, ysize => 110);
#!perl -w
use strict;
use Imager qw(:all :handy);
-use Test::More tests => 29;
+use Test::More tests => 31;
use Imager::Test qw(test_colorf_gpix is_fcolor1 is_fcolor3);
-d "testout" or mkdir "testout";
is($im->errstr, "convert: invalid matrix: element 0 is not an array ref",
"check the error message");
}
+
+{
+ my $empty = Imager->new;
+ ok(!$empty->convert(preset => "addalpha"), "can't convert an empty image");
+ is($empty->errstr, "convert: empty input image", "check error message");
+}
#!perl -w
use strict;
-use Test::More tests => 6;
+use Test::More tests => 8;
-d "testout" or mkdir "testout";
ok( $im->map(maps=>[\@map1, [], \@map2]),
"test OO interface (maps by maps)");
}
+
+{
+ my $empty = Imager->new;
+ ok(!$empty->map(maps => [ \@map1, \@map2, \@map3 ]),
+ "can't map an empty image");
+ is($empty->errstr, "map: empty input image", "check error message");
+}
{ # check empty image errors
my $empty = Imager->new;
ok(!$empty->rubthrough(src => $oosrc), "check empty target");
- is($empty->errstr, 'empty input image', "check error message");
+ is($empty->errstr, 'rubthrough: empty input image', "check error message");
ok(!$oogtarg->rubthrough(src=>$empty), "check empty source");
- is($oogtarg->errstr, 'empty input image for src',
+ is($oogtarg->errstr, 'rubthrough: empty input image (for src)',
"check error message");
}
#!perl -w
use strict;
-use Test::More tests => 16;
+use Test::More tests => 22;
use Imager;
$im_g->getcolorusagehash,
'color usage hash (grey)');
}
+
+{
+ my $empty = Imager->new;
+ is($empty->getcolorcount, undef, "can't getcolorcount an empty image");
+ is($empty->errstr, "getcolorcount: empty input image",
+ "check error message");
+ is($empty->getcolorusagehash, undef, "can't getcolorusagehash an empty image");
+ is($empty->errstr, "getcolorusagehash: empty input image",
+ "check error message");
+ is($empty->getcolorusage, undef, "can't getcolorusage an empty image");
+ is($empty->errstr, "getcolorusage: empty input image",
+ "check error message");
+}
$Test::More::VERSION =~ /^2\.00_/
and plan skip_all => "threads are hosed in 2.00_06 and presumably all 2.00_*";
-plan tests => 11;
+plan tests => 13;
my $thread = threads->create(sub { 1; });
ok($thread->join, "join first thread");
-# these are all, or contain, XS allocated objects, if we don't
-# probably handle CLONE requests, or provide a CLONE_SKIP, we'll
-# probably see a double-free, one from the thread, and the other from
-# the main line of control.
+# these are all, or contain, XS allocated objects, if we don't handle
+# CLONE requests, or provide a CLONE_SKIP, we'll probably see a
+# double-free, one from the thread, and the other from the main line
+# of control.
+#
# So make one of each
my $im = Imager->new(xsize => 10, ysize => 10);
(
sub {
ok(!UNIVERSAL::isa($im->{IMG}, "Imager::ImgRaw"),
- "the low level image object should be undef");
+ "the low level image object should become unblessed");
+ ok(!$im->_valid_image, "image no longer considered valid");
+ is($im->errstr, "images do not cross threads",
+ "check error message");
1;
}
);
projects / imager.git / commitdiff