From 1136f08912786165238910f3a2e906f48cb5bda4 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 12 Nov 2012 21:09:46 +1100 Subject: [PATCH] consistently use _valid_image() internally to ensure image validity and test for it. --- Imager.pm | 344 +++++++++++++++++++++++++--------------- Imager.xs | 5 +- MANIFEST | 1 + MANIFEST.SKIP | 1 + lib/Imager/Font/Test.pm | 92 +++++++++++ t/t01introvert.t | 49 +++++- t/t020masked.t | 9 +- t/t021sixteen.t | 2 +- t/t022double.t | 2 +- t/t023palette.t | 41 ++++- t/t1000files.t | 14 +- t/t21draw.t | 21 ++- t/t31font.t | 19 ++- t/t40scale.t | 6 +- t/t55trans.t | 10 +- t/t58trans2.t | 12 +- t/t61filters.t | 16 +- t/t62compose.t | 17 +- t/t63combine.t | 3 +- t/t64copyflip.t | 31 +++- t/t65crop.t | 8 +- t/t66paste.t | 16 +- t/t67convert.t | 8 +- t/t68map.t | 9 +- t/t69rubthru.t | 4 +- t/t90cc.t | 15 +- t/t99thread.t | 16 +- 27 files changed, 610 insertions(+), 161 deletions(-) create mode 100644 lib/Imager/Font/Test.pm diff --git a/Imager.pm b/Imager.pm index 85f04ed2..b15b4058 100644 --- a/Imager.pm +++ b/Imager.pm @@ -3,7 +3,7 @@ package Imager; 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; @@ -687,7 +687,9 @@ sub new { 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; @@ -705,16 +707,19 @@ sub copy { 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; @@ -773,7 +778,9 @@ sub paste { 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; @@ -861,7 +868,8 @@ sub crop { 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; @@ -924,7 +932,9 @@ sub img_set { sub masked { my $self = shift; - $self or return undef; + $self->_valid_image("masked") + or return; + my %opts = (left => 0, top => 0, right => $self->getwidth, @@ -965,7 +975,7 @@ sub to_paletted { return; } - $self->_valid_image + $self->_valid_image("to_paletted") or return; my $result = Imager->new; @@ -1006,7 +1016,7 @@ sub to_rgb8 { return; } - $self->_valid_image + $self->_valid_image("to_rgb8") or return; my $result = Imager->new; @@ -1028,7 +1038,7 @@ sub to_rgb16 { return; } - $self->_valid_image + $self->_valid_image("to_rgb16") or return; my $result = Imager->new; @@ -1050,7 +1060,7 @@ sub to_rgb_double { return; } - $self->_valid_image + $self->_valid_image("to_rgb_double") or return; my $result = Imager->new; @@ -1066,10 +1076,8 @@ sub addcolors { 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; @@ -1089,10 +1097,8 @@ sub setcolors { 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; @@ -1111,6 +1117,10 @@ sub setcolors { 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; @@ -1122,52 +1132,82 @@ sub getcolors { 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}); } @@ -1175,7 +1215,8 @@ sub is_bilevel { sub tags { my ($self, %opts) = @_; - $self->{IMG} or return; + $self->_valid_image("tags") + or return; if (defined $opts{name}) { my @result; @@ -1211,7 +1252,9 @@ sub addtag { 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+$/) { @@ -1259,7 +1302,8 @@ sub deltag { 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'}); @@ -1279,6 +1323,9 @@ sub deltag { 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}); @@ -1771,11 +1818,12 @@ sub write { 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}); @@ -1868,9 +1916,13 @@ sub write_multi { 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; @@ -2004,7 +2056,9 @@ sub filter { 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; } @@ -2179,10 +2233,8 @@ sub scale { 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) @@ -2236,10 +2288,8 @@ sub scaleX { return; } - unless ($self->{IMG}) { - $self->{ERRSTR} = 'empty input image'; - return undef; - } + $self->_valid_image("scaleX") + or return; my $img = Imager->new(); @@ -2276,7 +2326,8 @@ sub scaleY { return; } - unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; } + $self->_valid_image("scaleY") + or return; my $img = Imager->new(); @@ -2307,13 +2358,15 @@ sub scaleY { 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;"); @@ -2405,6 +2458,15 @@ sub transform2 { $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; @@ -2459,13 +2521,12 @@ sub rubthrough { 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, @@ -2502,18 +2563,16 @@ sub compose { @_ ); - 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}; @@ -2549,8 +2608,8 @@ sub compose { 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; } @@ -2584,6 +2643,10 @@ sub compose { 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'}}; @@ -2602,6 +2665,9 @@ sub rotate { return; } + $self->_valid_image("rotate") + or return; + if (defined $opts{right}) { my $degrees = $opts{right}; if ($degrees < 0) { @@ -2661,6 +2727,9 @@ sub matrix_transform { 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"; @@ -2709,10 +2778,8 @@ sub box { my $self=shift; my $raw = $self->{IMG}; - unless ($raw) { - $self->{ERRSTR}='empty input image'; - return undef; - } + $self->_valid_image("box") + or return; my %opts = @_; @@ -2790,7 +2857,10 @@ sub box { 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= @@ -2892,7 +2962,9 @@ sub line { 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; } @@ -2923,7 +2995,8 @@ sub polyline { 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'}) ) { @@ -2962,7 +3035,8 @@ sub polygon { 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}} ]; @@ -3009,7 +3083,8 @@ sub polybezier { 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'}}; @@ -3035,6 +3110,9 @@ sub flood_fill { 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; @@ -3252,7 +3330,8 @@ sub getscanline { 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}; @@ -3287,7 +3366,8 @@ sub setscanline { 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"); @@ -3348,6 +3428,9 @@ sub getsamples { 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'}) { @@ -3418,10 +3501,8 @@ sub getsamples { 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; @@ -3503,6 +3584,9 @@ sub convert { 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"; @@ -3621,8 +3705,8 @@ sub combine { $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}; @@ -3652,6 +3736,9 @@ sub map { 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; @@ -3672,15 +3759,17 @@ sub map { 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}, @@ -3704,12 +3793,10 @@ sub border { 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 @@ -3717,19 +3804,20 @@ sub getwidth { 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}); } @@ -3737,7 +3825,10 @@ sub getchannels { 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}); } @@ -3746,14 +3837,15 @@ sub getmask { 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; @@ -3764,7 +3856,10 @@ sub setmask { 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); } @@ -3773,7 +3868,10 @@ sub getcolorcount { # 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) { @@ -3781,11 +3879,6 @@ sub getcolorusagehash { 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) @@ -3809,6 +3902,9 @@ sub getcolorusagehash { 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) { @@ -3816,11 +3912,6 @@ sub getcolorusage { return; } - unless (defined $self->{IMG}) { - $self->_set_error('empty input image'); - return undef; - } - return i_get_anonymous_color_histo($self->{IMG}, $max_colors); } @@ -3828,7 +3919,9 @@ sub getcolorusage { 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}; @@ -3855,10 +3948,9 @@ sub align_string { my $img; if (ref $self) { - unless ($self->{IMG}) { - $self->{ERRSTR}='empty input image'; - return; - } + $self->_valid_image("align_string") + or return; + $img = $self; } else { diff --git a/Imager.xs b/Imager.xs index c47884ec..27505206 100644 --- a/Imager.xs +++ b/Imager.xs @@ -2122,7 +2122,7 @@ i_convert(src, avmain) RETVAL -void +undef_int i_map(im, pmaps) Imager::ImgRaw im PREINIT: @@ -2160,6 +2160,9 @@ i_map(im, pmaps) } i_map(im, maps, mask); myfree(maps); + RETVAL = 1; + OUTPUT: + RETVAL diff --git a/MANIFEST b/MANIFEST index 31cd9713..85f0d9a4 100644 --- a/MANIFEST +++ b/MANIFEST @@ -185,6 +185,7 @@ lib/Imager/Font.pm 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 diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index ef04e5dd..b1d5a898 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -134,3 +134,4 @@ Makefile\.old$ # sub-module build junk \.bak$ +MYMETA.json \ No newline at end of file diff --git a/lib/Imager/Font/Test.pm b/lib/Imager/Font/Test.pm new file mode 100644 index 00000000..9617089b --- /dev/null +++ b/lib/Imager/Font/Test.pm @@ -0,0 +1,92 @@ +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 + +=cut + diff --git a/t/t01introvert.t b/t/t01introvert.t index 612d1858..4a1e4b51 100644 --- a/t/t01introvert.t +++ b/t/t01introvert.t @@ -3,7 +3,7 @@ # 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)) } @@ -197,11 +197,36 @@ is($impal2->getheight, 201, "check height"); 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 @@ -1076,6 +1101,24 @@ my $psamp_outside_error = "Image position outside of image"; } } +{ + 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}) { diff --git a/t/t020masked.t b/t/t020masked.t index a5200546..95d5f1a0 100644 --- a/t/t020masked.t +++ b/t/t020masked.t @@ -1,6 +1,6 @@ #!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); @@ -687,6 +687,13 @@ for my $masked (0, 1) { # psampf "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}) { diff --git a/t/t021sixteen.t b/t/t021sixteen.t index 46d0d0dd..a1054e5c 100644 --- a/t/t021sixteen.t +++ b/t/t021sixteen.t @@ -210,7 +210,7 @@ cmp_ok(Imager->errstr, '=~', qr/channels must be between 1 and 4/, 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 diff --git a/t/t022double.t b/t/t022double.t index 05807715..6a2f7573 100644 --- a/t/t022double.t +++ b/t/t022double.t @@ -166,7 +166,7 @@ cmp_ok(Imager->errstr, '=~', qr/channels must be between 1 and 4/, 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"; diff --git a/t/t023palette.t b/t/t023palette.t index 0a96b8f7..db37a0bc 100644 --- a/t/t023palette.t +++ b/t/t023palette.t @@ -1,7 +1,7 @@ #!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); @@ -29,7 +29,9 @@ my $blacki = $img->addcolors(colors=>[ $black, $red, $green, $blue ]); 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; @@ -590,6 +592,41 @@ my $psamp_outside_error = "Image position outside of image"; 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}) { diff --git a/t/t1000files.t b/t/t1000files.t index 22cbdf0a..4b7764b1 100644 --- a/t/t1000files.t +++ b/t/t1000files.t @@ -4,7 +4,7 @@ # the file format use strict; -use Test::More tests => 85; +use Test::More tests => 89; use Imager; -d "testout" or mkdir "testout"; @@ -146,6 +146,18 @@ is(Imager->errstr, "check_file_limits: width must be a positive integer", } } +{ # 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"); diff --git a/t/t21draw.t b/t/t21draw.t index 0fb5b2e5..a1f7f2ab 100644 --- a/t/t21draw.t +++ b/t/t21draw.t @@ -1,6 +1,6 @@ #!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; @@ -297,6 +297,25 @@ my $white = '#FFFFFF'; } } +{ + 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(); diff --git a/t/t31font.t b/t/t31font.t index b2664859..0d1bd65b 100644 --- a/t/t31font.t +++ b/t/t31font.t @@ -1,7 +1,7 @@ #!perl -w use strict; use Imager; -use Test::More tests => 10; +use Test::More tests => 14; unshift @INC, "t"; @@ -40,3 +40,20 @@ SKIP: 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"); +} diff --git a/t/t40scale.t b/t/t40scale.t index 7e2a149b..6a995548 100644 --- a/t/t40scale.t +++ b/t/t40scale.t @@ -103,13 +103,13 @@ ok($scaleimg->write(file=>'testout/t40scale3.ppm', type=>'pnm'), { # 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 diff --git a/t/t55trans.t b/t/t55trans.t index ba1c6a0b..5554f2a8 100644 --- a/t/t55trans.t +++ b/t/t55trans.t @@ -6,7 +6,7 @@ use Imager; eval "use Affix::Infix2Postfix; 1;" or plan skip_all => "No Affix::Infix2Postfix"; -plan tests => 6; +plan tests => 8; #$Imager::DEBUG=1; @@ -47,4 +47,10 @@ SKIP: } } - +{ + 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"); +} diff --git a/t/t58trans2.t b/t/t58trans2.t index ab569ff2..b9ebf583 100644 --- a/t/t58trans2.t +++ b/t/t58trans2.t @@ -1,6 +1,6 @@ #!perl -w use strict; -use Test::More tests => 38; +use Test::More tests => 40; BEGIN { use_ok('Imager'); } use Imager::Test qw(is_color3); @@ -143,6 +143,16 @@ op_test('FF80C0', <<'EOS', 127, 0, 0, 'sat'); 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 diff --git a/t/t61filters.t b/t/t61filters.t index 84bdc447..b6f8c305 100644 --- a/t/t61filters.t +++ b/t/t61filters.t @@ -1,7 +1,7 @@ #!perl -w use strict; use Imager qw(:handy); -use Test::More tests => 116; +use Test::More tests => 122; -d "testout" or mkdir "testout"; @@ -424,6 +424,20 @@ is($name, "test gradient", "check the name matches"); 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) = @_; diff --git a/t/t62compose.t b/t/t62compose.t index d7e415bd..cbf8af30 100644 --- a/t/t62compose.t +++ b/t/t62compose.t @@ -1,7 +1,7 @@ #!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"; @@ -239,6 +239,21 @@ for my $type_id (sort keys %types) { } } +{ + 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; } diff --git a/t/t63combine.t b/t/t63combine.t index b94b97a2..6cbe88b2 100644 --- a/t/t63combine.t +++ b/t/t63combine.t @@ -34,7 +34,8 @@ my $test_im_dbl = test_image_double; # 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"); } { diff --git a/t/t64copyflip.t b/t/t64copyflip.t index 1a0a4368..2632fd53 100644 --- a/t/t64copyflip.t +++ b/t/t64copyflip.t @@ -1,6 +1,6 @@ #!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); @@ -21,6 +21,12 @@ ok($nimg, "copy returned something"); 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"); @@ -34,6 +40,12 @@ is_image($nimg, $img, "double vertically flipped image 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; @@ -148,6 +160,16 @@ ok($trimg, "matrix_transform() with back returned an image"); $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) = @_; @@ -254,3 +276,10 @@ sub rot_test { # 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"); +} diff --git a/t/t65crop.t b/t/t65crop.t index 3adaa151..3b19d98f 100644 --- a/t/t65crop.t +++ b/t/t65crop.t @@ -1,6 +1,6 @@ #!perl -w use strict; -use Test::More tests => 64; +use Test::More tests => 66; use Imager; use Imager::Test qw(test_image); @@ -182,3 +182,9 @@ SKIP: "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"); +} diff --git a/t/t66paste.t b/t/t66paste.t index c8f1f377..85998236 100644 --- a/t/t66paste.t +++ b/t/t66paste.t @@ -1,6 +1,6 @@ #!perl -w use strict; -use Test::More tests => 54; +use Test::More tests => 60; use Imager; use Imager::Test qw(is_image); @@ -25,6 +25,20 @@ ok($img->paste(img=>$nimg, top=>30, left=>30), "paste it") 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); diff --git a/t/t67convert.t b/t/t67convert.t index eccc5911..a4517cc1 100644 --- a/t/t67convert.t +++ b/t/t67convert.t @@ -1,7 +1,7 @@ #!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"; @@ -149,3 +149,9 @@ SKIP: 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"); +} diff --git a/t/t68map.t b/t/t68map.t index b4539940..b91f43d2 100644 --- a/t/t68map.t +++ b/t/t68map.t @@ -1,6 +1,6 @@ #!perl -w use strict; -use Test::More tests => 6; +use Test::More tests => 8; -d "testout" or mkdir "testout"; @@ -39,3 +39,10 @@ SKIP: { 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"); +} diff --git a/t/t69rubthru.t b/t/t69rubthru.t index ae78d1c6..a1fa3d35 100644 --- a/t/t69rubthru.t +++ b/t/t69rubthru.t @@ -75,9 +75,9 @@ my $oogtarg = Imager->new(xsize=>100, ysize=>100, channels=>1); { # 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"); } diff --git a/t/t90cc.t b/t/t90cc.t index 50a9158e..c38453e8 100644 --- a/t/t90cc.t +++ b/t/t90cc.t @@ -1,6 +1,6 @@ #!perl -w use strict; -use Test::More tests => 16; +use Test::More tests => 22; use Imager; @@ -69,3 +69,16 @@ Imager::init('log'=>'testout/t90cc.log'); $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"); +} diff --git a/t/t99thread.t b/t/t99thread.t index 0d05fe39..86e46f03 100644 --- a/t/t99thread.t +++ b/t/t99thread.t @@ -32,15 +32,16 @@ $INC{"Devel/Cover.pm"} $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); @@ -81,7 +82,10 @@ my $t2 = threads->create ( 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; } ); -- 2.39.5