From: Tony Cook Date: Thu, 9 Nov 2006 12:48:13 +0000 (+0000) Subject: switch to Test::More in a few more test scripts, eliminate the X-Git-Tag: Imager-0.55~10 X-Git-Url: http://git.imager.perl.org/imager.git/commitdiff_plain/64f9ab490b0b370b6a8aa26f8f134f69b50ea3f9 switch to Test::More in a few more test scripts, eliminate the testtools okx/okn variants --- diff --git a/t/t36oofont.t b/t/t36oofont.t index 6d374c93..e24d0c9d 100644 --- a/t/t36oofont.t +++ b/t/t36oofont.t @@ -10,14 +10,10 @@ use strict; # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) +use lib 't'; +use Test::More tests => 20; -my $loaded; -BEGIN { $| = 1; print "1..20\n"; } -END {print "not ok 1\n" unless $loaded;} -use Imager; -BEGIN { require "t/testtools.pl"; } -$loaded=1; -okx(1, "loaded"); +BEGIN { use_ok('Imager') }; init_log("testout/t36oofont.log", 1); @@ -30,66 +26,70 @@ die $Imager::ERRSTR unless $green; my $red=Imager::Color->new(205, 92, 92, 255); die $Imager::ERRSTR unless $red; -if (i_has_format("t1") and -f $fontname_pfb) { +SKIP: +{ + i_has_format("t1") && -f $fontname_pfb + or skip("T1lib missing or disabled", 8); my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n"; my $font=Imager::Font->new(file=>$fontname_pfb,size=>25) or die $img->{ERRSTR}; - okx(1, "created font"); + ok(1, "created font"); - okx($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100), + ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100), "draw text"); $img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green); my $text="LLySja"; my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50); - isx(@bbox, 8, "bounding box list length"); + is(@bbox, 8, "bounding box list length"); $img->box(box=>\@bbox, color=>$green); # "utf8" support $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41); - okx($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1, + ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1, overline=>1), "draw 'utf8' hand-encoded text"); - okx($img->string(font=>$font, text=>$text, 'x'=>140, 'y'=>50, utf8=>1, + ok($img->string(font=>$font, text=>$text, 'x'=>140, 'y'=>50, utf8=>1, underline=>1, channel=>2), "channel 'utf8' hand-encoded text"); - if($] >= 5.006) { + SKIP: + { + $] >= 5.006 + or skip("perl too old for native utf8", 2); eval q{$text = "A\x{2010}A"}; - okx($img->string(font=>$font, text=>$text, 'x'=>180, 'y'=>50, + ok($img->string(font=>$font, text=>$text, 'x'=>180, 'y'=>50, strikethrough=>1), "draw native UTF8 text"); - okx($img->string(font=>$font, text=>$text, 'x'=>220, 'y'=>50, channel=>1), + ok($img->string(font=>$font, text=>$text, 'x'=>220, 'y'=>50, channel=>1), "channel native UTF8 text"); } - else { - skipx(2, "perl too old for native utf8"); - } - okx($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'), + ok($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'), "write t36oofont1.ppm") or print "# ",$img->errstr,"\n"; -} else { - skipx(8, "T1lib missing or disabled"); } -if (i_has_format("tt") and -f $fontname_tt) { +SKIP: +{ + i_has_format("tt") && -f $fontname_tt + or skip("FT1.x missing or disabled", 10); my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n"; my $font=Imager::Font->new(file=>$fontname_tt,size=>25) or die $img->{ERRSTR}; - okx(1, "create TT font object"); + ok(1, "create TT font object"); - okx($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100), + ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100), "draw text"); $img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green); @@ -97,36 +97,34 @@ if (i_has_format("tt") and -f $fontname_tt) { my $text="LLySja"; my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50); - isx(@bbox, 8, "bbox list size"); + is(@bbox, 8, "bbox list size"); $img->box(box=>\@bbox, color=>$green); $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41); - okx($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1), + ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1), "draw hand-encoded UTF8 text"); - if($] >= 5.006) { + SKIP: + { + $] >= 5.006 + or skip("perl too old for native utf8", 1); eval q{$text = "A\x{2010}A"}; - okx($img->string(font=>$font, text=>$text, 'x'=>200, 'y'=>50), + ok($img->string(font=>$font, text=>$text, 'x'=>200, 'y'=>50), "draw native UTF8 text"); } - else { - skipx(1, "perl too old for native utf8"); - } - okx($img->write(file=>"testout/t36oofont2.ppm", type=>'pnm'), + ok($img->write(file=>"testout/t36oofont2.ppm", type=>'pnm'), "write t36oofont2.ppm") or print "# ", $img->errstr,"\n"; - okx($font->utf8, "make sure utf8 method returns true"); + ok($font->utf8, "make sure utf8 method returns true"); my $has_chars = $font->has_chars(string=>"\x01A"); - okx($has_chars eq "\x00\x01", "has_chars scalar"); + ok($has_chars eq "\x00\x01", "has_chars scalar"); my @has_chars = $font->has_chars(string=>"\x01A"); - okx(!$has_chars[0], "has_chars list 0"); - okx($has_chars[1], "has_chars list 1"); -} else { - skipx(10, "FT1.x missing or disabled"); + ok(!$has_chars[0], "has_chars list 0"); + ok($has_chars[1], "has_chars list 1"); } -okx(1, "end"); +ok(1, "end"); diff --git a/t/t58trans2.t b/t/t58trans2.t index 5b29e6a0..3c29d41b 100644 --- a/t/t58trans2.t +++ b/t/t58trans2.t @@ -1,16 +1,7 @@ #!perl -w -BEGIN { $| = 1; print "1..16\n"; } -END {print "not ok 1\n" unless $loaded;} -use Imager; - -sub ok($$); -sub is($$$); -my $num = 1; - -$loaded = 1; -ok(1, "loaded"); - -#$Imager::DEBUG=1; +use strict; +use Test::More tests => 16; +BEGIN { use_ok('Imager'); } Imager::init('log'=>'testout/t58trans2.log'); @@ -104,32 +95,3 @@ my $im7 = Imager::transform2({rpnexpr=>'x y getp2', width=>100, height=>100}); ok(!$im7, "expected failure on accessing invalid image"); print "# ", Imager->errstr, "\n"; ok(Imager->errstr =~ /not enough images/, "didn't get expected error"); - - -sub ok ($$) { - my ($test, $desc) = @_; - - if ($test) { - print "ok $num # $desc\n"; - } - else { - print "not ok $num # $desc\n"; - } - ++$num; - $test; -} - -sub is ($$$) { - my ($left, $right, $desc) = @_; - - my $eq = $left == $right; - unless (ok($eq, $desc)) { - $left =~ s/\n/# \n/g; - $left =~ s/([^\n\x20-\x7E])/"\\x".sprintf("%02X", ord $1)/ge; - $right =~ s/\n/# \n/g; - $right =~ s/([^\n\x20-\x7E])/"\\x".sprintf("%02X", ord $1)/ge; - print "# not equal, left = '$left'\n"; - print "# right = '$right'\n"; - } - $eq; -} diff --git a/t/t80texttools.t b/t/t80texttools.t index 8483b5ed..ae37b98b 100644 --- a/t/t80texttools.t +++ b/t/t80texttools.t @@ -1,16 +1,10 @@ +#!perl -w use strict; -my $loaded; -BEGIN { - require "t/testtools.pl"; - $| = 1; print "1..11\n"; -} -END { okx(0, "loading") unless $loaded; } -use Imager; -$loaded = 1; +use Test::More tests => 11; -okx(1, "Loaded"); +BEGIN { use_ok('Imager') } -requireokx("Imager/Font/Wrap.pm", "load basic wrapping"); +require_ok('Imager::Font::Wrap'); my $img = Imager->new(xsize=>400, ysize=>400); @@ -40,14 +34,16 @@ my $fontfile = $ENV{WRAPTESTFONT} || $ENV{TTFONTTEST} || "fontfiles/ImUgly.ttf"; my $font = Imager::Font->new(file=>$fontfile); -unless (Imager::i_has_format('tt') || Imager::i_has_format('ft2')) { - skipx(9, "Need Freetype 1.x or 2.x to test"); - exit; -} +SKIP: +{ + Imager::i_has_format('tt') || Imager::i_has_format('ft2') + or skip("Need Freetype 1.x or 2.x to test", 9); + + ok($font, "loading font") + or skip("Could not load test font", 8); -if (okx($font, "loading font")) { Imager::Font->priorities(qw(t1 ft2 tt)); - okx(scalar Imager::Font::Wrap->wrap_text(string => $text, + ok(scalar Imager::Font::Wrap->wrap_text(string => $text, font=>$font, image=>$img, size=>13, @@ -56,8 +52,8 @@ if (okx($font, "loading font")) { justify=>'fill', color=>'FFFFFF'), "basic test"); - okx($img->write(file=>'testout/t80wrapped.ppm'), "save to file"); - okx(scalar Imager::Font::Wrap->wrap_text(string => $text, + ok($img->write(file=>'testout/t80wrapped.ppm'), "save to file"); + ok(scalar Imager::Font::Wrap->wrap_text(string => $text, font=>$font, image=>undef, size=>13, @@ -67,22 +63,19 @@ if (okx($font, "loading font")) { color=>'FFFFFF'), "no image test"); my $bbox = $font->bounding_box(string=>"Xx", size=>13); - okx($bbox, "get height for check"); + ok($bbox, "get height for check"); my $used; - okx(scalar Imager::Font::Wrap->wrap_text + ok(scalar Imager::Font::Wrap->wrap_text (string=>$text, font=>$font, image=>undef, size=>13, width=>380, savepos=> \$used, height => $bbox->font_height), "savepos call"); - okx($used > 20 && $used < length($text), "savepos value"); + ok($used > 20 && $used < length($text), "savepos value"); print "# $used\n"; my @box = Imager::Font::Wrap->wrap_text (string=>substr($text, 0, $used), font=>$font, image=>undef, size=>13, width=>380); - okx(@box == 4, "bounds list count"); + ok(@box == 4, "bounds list count"); print "# @box\n"; - okx($box[3] == $bbox->font_height, "check height"); -} -else { - skipx(8, "Could not load test font"); + ok($box[3] == $bbox->font_height, "check height"); } diff --git a/t/testtools.pl b/t/testtools.pl index 094a42e8..a7a79cef 100644 --- a/t/testtools.pl +++ b/t/testtools.pl @@ -29,134 +29,6 @@ sub test_oo_img { $img; } -sub skipn { - my ($testnum, $count, $why) = @_; - - $why = '' unless defined $why; - - print "ok $_ # skip $why\n" for $testnum ... $testnum+$count-1; -} - -sub skipx { - my ($count, $why) = @_; - - skipn($TESTNUM, $count, $why); - $TESTNUM += $count; -} - -sub okx ($$) { - my ($ok, $comment) = @_; - - return okn($TESTNUM++, $ok, $comment); -} - -sub okn ($$$) { - my ($num, $ok, $comment) = @_; - - defined $num or confess "No \$num supplied"; - defined $comment or confess "No \$comment supplied"; - if ($ok) { - print "ok $num # $comment\n"; - } - else { - print "not ok $num # $comment\n"; - } - - return $ok; -} - -sub requireokx { - my ($file, $comment) = @_; - - eval { - require $file; - }; - if ($@) { - my $msg = $@; - $msg =~ s/\n+$//; - $msg =~ s/\n/\n# /g; - okx(0, $comment); - print "# $msg\n"; - } - else { - okx(1, $comment); - } -} - -sub useokx { - my ($module, $comment, @imports) = @_; - - my $pack = caller; - eval <import(\@imports); -EOS - unless (okx(!$@, $comment)) { - my $msg = $@; - $msg =~ s/\n+$//; - $msg =~ s/\n/\n# /g; - print "# $msg\n"; - return 0; - } - else { - return 1; - } -} - -sub matchn($$$$) { - my ($num, $str, $re, $comment) = @_; - - my $match = defined($str) && $str =~ $re; - okn($num, $match, $comment); - unless ($match) { - print "# The value: ",_sv_str($str),"\n"; - print "# did not match: qr/$re/\n"; - } - return $match; -} - -sub matchx($$$) { - my ($str, $re, $comment) = @_; - - matchn($TESTNUM++, $str, $re, $comment); -} - -sub isn ($$$$) { - my ($num, $left, $right, $comment) = @_; - - my $match; - if (!defined $left && defined $right - || defined $left && !defined $right) { - $match = 0; - } - elsif (!defined $left && !defined $right) { - $match = 1; - } - # the right of the || produces a string of \0 if $left is a PV - # which is true - elsif (!length $left || ($left & ~$left) || - !length $right || ($right & ~$right)) { - $match = $left eq $right; - } - else { - $match = $left == $right; - } - okn($num, $match, $comment); - unless ($match) { - print "# the following two values were not equal:\n"; - print "# value: ",_sv_str($left),"\n"; - print "# other: ",_sv_str($right),"\n"; - } - - $match; -} - -sub isx ($$$) { - my ($left, $right, $comment) = @_; - - isn($TESTNUM++, $left, $right, $comment); -} sub _sv_str { my ($value) = @_;